Tetris mit Canvas funktioniert nicht wie es soll

[Bjoerk]

Ja, das Drehen ist in der Tat nicht so einfach. Hierzu muß man erst mal wissen um welchen Punkt man drehen will. Was die Sache aber wieder vereinfacht, ist daß sin+/-90° eins bzw. minus eins ist Und Cos Null ist).

Als Drehpunkt bietet sich den Schwerpunkt der Figur an. Dieser ist Näherungsweise SummeXi/4, SummeYi/4.

Dann verschiebt man das Koordinatensystem in diesen Punkt, dreht den Stein und verschiebt anschließend wieder zurück auf das Ursprungssytem. Ich hab jetzt keine Zeit mir deinen Code anzuschauen, sieh' mal meine Methoden GetCurrentCenterPoint und MoveCurrent:

Delphi-Quellcode:

unit uTetris;

interface

uses
  SysUtils, Classes, Contnrs, Graphics, Dialogs, Types;

type
  TFigurPoints = array[0..3] of TPoint;
  TFigurType = (ftO, ftJ, ftL, ftT, ftI, ftZ, ftS);
  TFigurMove = (fmMoveLeft, fmMoveRight, fmTurnRight, fmMoveDown);

  TToken = class
  private
    FColor: TColor;
    FX, FY: integer;
  public
    procedure Draw(Canvas: TCanvas; TokenSize: integer);
    property Color: TColor read FColor write FColor;
    property X: integer read FX write FX;
    property Y: integer read FY write FY;
  end;

  TTetris = class(TObjectList)
  private
    FBitmap: TBitmap;
    FColCount, FRowCount, FLevel, FScore, FTokenSize: integer;
    function GetToken(Index: integer): TToken;
    function TokenAdd(Color: TColor; X, Y: integer): TToken;
    function MoveCurrent(FigurMove: TFigurMove; Applying: boolean): boolean;
    function GetCurrentCenterPoint: TPoint;
    function CanMoveCurrent(const P: TFigurPoints): boolean;
    function CanSetCurrent(const P: TFigurPoints): boolean;
    function GetCurrent: TFigurPoints;
    procedure SetCurrent(const Value: TFigurPoints);
    procedure DelLine(Row: integer);
    property FToken[Index: integer]: TToken read GetToken;
    property FCurrent: TFigurPoints read GetCurrent write SetCurrent;
  public
    procedure AddNewCurrent;
    function CurrentMoveDown: boolean;
    function CurrentMoveLeft: boolean;
    function CurrentMoveRight: boolean;
    function CurrentTurnRight: boolean;
    procedure CurrentFallDown;
    procedure Draw;
    procedure DelLines;
    function GameOver: boolean;
    constructor Create;
    destructor Destroy; override;
    property Score: integer read FScore write FScore;
    property TokenSize: integer read FTokenSize write FTokenSize;
    property ColCount: integer read FColCount write FColCount;
    property RowCount: integer read FRowCount write FRowCount;
    property Level: integer read FLevel write FLevel;
    property Bitmap: TBitmap read FBitmap;
  end;

implementation

{ TToken }

procedure TToken.Draw(Canvas: TCanvas; TokenSize: integer);
var
  X1, X2, X3, Y1, Y2, Y3: integer;
begin
  X1 := FX * TokenSize;
  Y1 := FY * TokenSize;
  X2 := X1 + TokenSize;
  Y2 := Y1 + TokenSize;
  X3 := TokenSize div 4;
  Y3 := X3;
  Canvas.Brush.Color := FColor;
  Canvas.Pen.Color := clBlack;
  Canvas.RoundRect(X1, Y1, X2, Y2, X3, Y3);
end;

{ TTetris }

function TTetris.GetToken(Index: integer): TToken;
begin
  Result := TToken(Items[Index]);
end;

function TTetris.GetCurrent: TFigurPoints;
var
  J: integer;
begin
  for J := 1 to 4 do
  begin
    Result[J - 1].X := FToken[Count - J].X;
    Result[J - 1].Y := FToken[Count - J].Y;
  end;
end;

procedure TTetris.SetCurrent(const Value: TFigurPoints);
var
  J: integer;
begin
  for J := 1 to 4 do
  begin
    FToken[Count - J].X := Value[J - 1].X;
    FToken[Count - J].Y := Value[J - 1].Y;
  end;
end;

procedure TTetris.AddNewCurrent;
const
  FigurTypeCount = 7;
  clOrange = $000080FF;
var
  Left: integer;
  FigurType: TFigurType;
begin
  Left := Random(FColCount - 3);
  FigurType := TFigurType(Random(FigurTypeCount));
  case FigurType of
    ftO:
    begin
      TokenAdd(clYellow, Left, 0);
      TokenAdd(clYellow, Left + 1, 0);
      TokenAdd(clYellow, Left, 1);
      TokenAdd(clYellow, Left + 1, 1);
    end;
    ftJ:
    begin
      TokenAdd(clBlue, Left + 1, 2);
      TokenAdd(clBlue, Left + 1, 1);
      TokenAdd(clBlue, Left + 1, 0);
      TokenAdd(clBlue, Left, 2);
    end;
    ftL:
    begin
      TokenAdd(clOrange, Left + 1, 2);
      TokenAdd(clOrange, Left + 1, 1);
      TokenAdd(clOrange, Left + 1, 0);
      TokenAdd(clOrange, Left + 2, 2);
    end;
    ftT:
    begin
      TokenAdd(clPurple, Left + 1, 1);
      TokenAdd(clPurple, Left, 0);
      TokenAdd(clPurple, Left + 1, 0);
      TokenAdd(clPurple, Left + 2, 0);
    end;
    ftI:
    begin
      TokenAdd(clAqua, Left, 0);
      TokenAdd(clAqua, Left, 1);
      TokenAdd(clAqua, Left, 2);
      TokenAdd(clAqua, Left, 3);
    end;
    ftZ:
    begin
      TokenAdd(clRed, Left + 1, 1);
      TokenAdd(clRed, Left + 2, 1);
      TokenAdd(clRed, Left + 1, 0);
      TokenAdd(clRed, Left, 0);
    end;
    ftS:
    begin
      TokenAdd(clGreen, Left, 1);
      TokenAdd(clGreen, Left + 1, 1);
      TokenAdd(clGreen, Left + 1, 0);
      TokenAdd(clGreen, Left + 2, 0);
    end;
  end;
  Draw;
end;

function TTetris.GetCurrentCenterPoint: TPoint;
var
  J: integer;
  P: TFigurPoints;
begin
  Result.X := 0;
  Result.Y := 0;
  P := FCurrent;
  for J := 0 to 3 do
  begin
    Result.X := Result.X + P[J].X;
    Result.Y := Result.Y + P[J].Y;
  end;
  Result.X := Round(Result.X / 4);
  Result.Y := Round(Result.Y / 4);
end;

function TTetris.CanMoveCurrent(const P: TFigurPoints): boolean;
var
  I, J: integer;
begin
  Result := true;
  for I := 0 to Count - 5 do
    for J := 0 to 3 do
      if (P[J].X = FToken[I].X) and (P[J].Y = FToken[I].Y) then
        Result := false;
end;

function TTetris.CanSetCurrent(const P: TFigurPoints): boolean;
var
  J: integer;
begin
  Result := true;
  for J := 0 to 3 do
    if (P[J].X < 0) or (P[J].X >= FColCount)
      or (P[J].Y < 0) or (P[J].Y >= FRowCount) then
        Result := false;
  Result := Result and CanMoveCurrent(P);
end;

function TTetris.MoveCurrent(FigurMove: TFigurMove; Applying: boolean): boolean;
var
  J: integer;
  ACurrentCenterPoint: TPoint;
  ACurrent, ACurrentCenter: TFigurPoints;
begin
  Result := false;
  ACurrent := FCurrent;
  case FigurMove of
    fmMoveLeft:
      for J := 0 to 3 do
        Dec(ACurrent[J].X);
    fmMoveRight:
      for J := 0 to 3 do
        Inc(ACurrent[J].X);
    fmMoveDown:
      for J := 0 to 3 do
        Inc(ACurrent[J].Y);
    fmTurnRight:
    begin
      ACurrentCenterPoint := GetCurrentCenterPoint;
      for J := 0 to 3 do
      begin
        ACurrentCenter[J].X := ACurrent[J].X - ACurrentCenterPoint.X;
        ACurrentCenter[J].Y := ACurrent[J].Y - ACurrentCenterPoint.Y;
      end;
      for J := 0 to 3 do
      begin
        ACurrent[J].X := -ACurrentCenter[J].Y + ACurrentCenterPoint.X;
        ACurrent[J].Y :=  ACurrentCenter[J].X + ACurrentCenterPoint.Y;
      end;
    end;
  end;
  if CanSetCurrent(ACurrent) then
  begin
    Result := true;
    if Applying then
      FCurrent := ACurrent;
  end;
end;

function TTetris.CurrentMoveDown: boolean;
begin
  Result := MoveCurrent(fmMoveDown, true);
end;

function TTetris.CurrentMoveLeft: boolean;
begin
  Result := MoveCurrent(fmMoveLeft, true);
end;

function TTetris.CurrentMoveRight: boolean;
begin
  Result := MoveCurrent(fmMoveRight, true);
end;

function TTetris.CurrentTurnRight: boolean;
begin
  Result := MoveCurrent(fmTurnRight, true);
end;

procedure TTetris.CurrentFallDown;
begin
  while CurrentMoveDown do
    Inc(FScore);
end;

function TTetris.GameOver: boolean;
begin
  Result := not MoveCurrent(fmMoveDown, false)
    and not MoveCurrent(fmMoveLeft, false)
    and not MoveCurrent(fmMoveRight, false)
    and not MoveCurrent(fmTurnRight, false);
end;

procedure TTetris.DelLine(Row: integer);
var
  I: integer;
begin
  for I := Count - 1 downto 0 do
    if FToken[I].Y = Row then
      Delete(I);
  for I := 0 to Count - 1 do
    if FToken[I].Y < Row then
      FToken[I].Y := FToken[I].Y + 1;
end;

procedure TTetris.DelLines;
var
  Row, Col, I, N, Rows: integer;
begin
  Row := FRowCount - 1;
  Rows := 0;
  while Row > 0 do
  begin
    N := 0;
    for Col := 0 to FColCount - 1 do
      for I := 0 to Count - 1 do
        if (FToken[I].X = Col) and (FToken[I].Y = Row) then
          Inc(N);
    if N = FColCount then
    begin
      DelLine(Row);
      Inc(Row);
      Inc(Rows);
    end;
    Dec(Row);
  end;
  case Rows of
    1: Inc(FSCore, FLevel * 40);
    2: Inc(FSCore, FLevel * 100);
    3: Inc(FSCore, FLevel * 300);
    4: Inc(FSCore, FLevel * 1200);
  end;
end;

procedure TTetris.Draw;
var
  I: integer;
begin
  FBitmap.Canvas.Brush.Color := clCream;
  FBitmap.Canvas.FillRect(Rect(0, 0, FBitmap.Width, FBitmap.Height));
  FBitmap.Canvas.Pen.Color := clSilver;
  for I := 1 to FColCount do
  begin
    FBitmap.Canvas.MoveTo(I * FTokenSize, 0);
    FBitmap.Canvas.LineTo(I * FTokenSize, FRowCount * FTokenSize);
  end;
  for I := 1 to FRowCount do
  begin
    FBitmap.Canvas.MoveTo(0, I * FTokenSize);
    FBitmap.Canvas.LineTo(FColCount * FTokenSize, I * FTokenSize);
  end;
  for I := 0 to Count - 1 do
    FToken[I].Draw(FBitmap.Canvas, FTokenSize);
end;

function TTetris.TokenAdd(Color: TColor; X, Y: integer): TToken;
begin
  Result := TToken.Create;
  Result.Color := Color;
  Result.X := X;
  Result.Y := Y;
  Add(Result);
end;

constructor TTetris.Create;
begin
  inherited Create(true);
  FBitmap := TBitmap.Create;
end;

destructor TTetris.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

end.