Tetris mit Canvas funktioniert nicht wie es soll

[Bjoerk]

Hab' mir den Code gründlich angeschaut. Zu dem Code gäbe es viel zu sagen. Hab' mal 'n bissel was gemacht.

Auf die einzelnen Blöcke kannst du mit der property Block zugreifen und die X und Y property brauchst du später.

Der Fehler tritt jetzt auch nicht mehr auf.

Gruß
Thomas

Delphi-Quellcode:

type
  TBlock = class
  private
    FFarbe: TColor;
    FPosition: TPoint;
    FBitmap: TBitmap;
    function GetX: integer;
    function GetY: integer;
    procedure SetX(const Value: integer);
    procedure SetY(const Value: integer);
  public
    procedure Zeichen;
    property Farbe: TColor read FFarbe write FFarbe;
    property Position: TPoint read FPosition write FPosition;
    property X: integer read GetX write SetX;
    property Y: integer read GetY write SetY;
    constructor Create(Bitmap: TBitmap);
  end;

  THaupt = class(TList)
  private
    FBitmap: TBitmap;
    function GetBlock(Index: integer): TBlock;
  public
    function BlockAdd(Bitmap: TBitmap; Farbe: TColor; X, Y: integer): TBlock;
    procedure DelBlock(Index: integer);
    procedure ClearList;
    procedure ClearArea;
    procedure Neu;
    procedure Neufallen;
    // procedure Drehen;
    // procedure Prufen;
    // procedure Entfernen;
    destructor Destroy; override;
    property Block[Index: integer]: TBlock read GetBlock; default;
    property Bitmap: TBitmap read FBitmap write FBitmap;
  end;

  TForm2 = class(TForm)
    Spielfeld: TImage;
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FHaupt: THaupt;
    FBitmap: TBitmap;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TBlock }

constructor TBlock.Create(Bitmap: TBitmap);
begin
  inherited Create;
  FBitmap := Bitmap;
end;

function TBlock.GetX: integer;
begin
  Result := FPosition.X;
end;

function TBlock.GetY: integer;
begin
  Result := FPosition.Y;
end;

procedure TBlock.SetX(const Value: integer);
begin
  FPosition.X := Value;
end;

procedure TBlock.SetY(const Value: integer);
begin
  FPosition.Y := Value;
end;

procedure TBlock.Zeichen;
begin
  FBitmap.Canvas.Brush.Color := FFarbe;
  FBitmap.Canvas.Brush.Style := bsSolid;
  FBitmap.Canvas.Rectangle(FPosition.X * 24, FPosition.Y * 24,
    FPosition.X * 24 + 24, FPosition.Y * 24 + 24);
end;

{ THaupt }

function THaupt.GetBlock(Index: integer): TBlock;
begin
  Result := Items[Index];
end;

function THaupt.BlockAdd(Bitmap: TBitmap; Farbe: TColor; X, Y: integer): TBlock;
begin
  Result := TBlock.Create(Bitmap);
  Result.Farbe := Farbe;
  Result.X := X;
  Result.Y := Y;
  Add(Result);
end;

procedure THaupt.DelBlock(Index: integer);
begin
  TBlock(Items[Index]).Free;
  Delete(Index);
end;

procedure THaupt.ClearList;
begin
  while Count > 0 do
    DelBlock(Count - 1);
end;

destructor THaupt.Destroy;
begin
  ClearList;
  inherited Destroy;
end;

procedure THaupt.Neu;
var
  Zufall: integer;
begin
  Zufall := Random(5) + 1;
  case Zufall of
    1:
    begin // Quadrat
      BlockAdd(FBitmap, clRed, 4, -2);
      BlockAdd(FBitmap, clRed, 5, -2);
      BlockAdd(FBitmap, clRed, 4, -1);
      BlockAdd(FBitmap, clRed, 5, -1);
    end;
    2:
    begin // Winkelrechts
      BlockAdd(FBitmap, clYellow, 4, -2);
      BlockAdd(FBitmap, clYellow, 4, -1);
      BlockAdd(FBitmap, clYellow, 5, -1);
      BlockAdd(FBitmap, clYellow, 6, -1);
    end;
    3:
    begin //Winkellinks
      BlockAdd(FBitmap, clBlue, 6, -2);
      BlockAdd(FBitmap, clBlue, 4, -1);
      BlockAdd(FBitmap, clBlue, 5, -1);
      BlockAdd(FBitmap, clBlue, 6, -1);
    end;
    4:
    begin //T
      BlockAdd(FBitmap, clLime, 5, -2);
      BlockAdd(FBitmap, clLime, 4, -1);
      BlockAdd(FBitmap, clLime, 5, -1);
      BlockAdd(FBitmap, clLime, 6, -1);
    end;
    5:
    begin // Rechteck
      BlockAdd(FBitmap, clPurple, 5, -4);
      BlockAdd(FBitmap, clPurple, 5, -3);
      BlockAdd(FBitmap, clPurple, 5, -2);
      BlockAdd(FBitmap, clPurple, 5, -1);
    end;
  end;
end;

procedure THaupt.ClearArea;
begin
  FBitmap.Canvas.Brush.Color := clWhite;
  FBitmap.Canvas.Brush.Style := bsSolid;
  FBitmap.Canvas.Rectangle(0, 0, FBitmap.Width, FBitmap.Height);
end;

procedure THaupt.Neufallen;
var
  I: integer;
begin
  ClearArea;
  for I := 0 to Count - 1 do
    Block[I].Y := Block[I].Y + 1;
  for I := 0 to Count - 1 do
    Block[I].Zeichen;
  if 24 * Block[Count - 1].Y > FBitmap.Height div 2 then // Test
    Neu;
end;

{ TForm2 }

procedure TForm2.Button1Click(Sender: TObject);
begin
  FHaupt.Neu;
  Timer1.Enabled := true;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Randomize;
  DoubleBuffered := true;
  FBitmap := TBitmap.Create;
  FBitmap.Width := SPielfeld.Width;
  FBitmap.Height := SPielfeld.Height;
  FHaupt := THaupt.Create;
  FHaupt.Bitmap := FBitmap;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
  FHaupt.Free;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false;
  FHaupt.Neufallen;
  Spielfeld.Picture.Assign(FBitmap);
  Application.ProcessMessages;
  Timer1.Enabled := true;
end;

end.