Tetris mit Canvas funktioniert nicht wie es soll

[fox67]

Zitat von Volker Z.:

Hallo,

Zitat:

Delphi erkenn die Pfeiltasten nicht als eingabe unter onkeydown? Keypreview habe ich auf true gestetzt.

Du hast ein TButton auf Deinem Formular. Der macht Dir einen Strich durch die Rechnung. Die Pfeiltasten werden vom Button verarbeitet und nicht mehr ans Form durchgereicht.

Gruß

Kann man das verhindern?

Gruß Arni

[Bjoerk]

Mach aus dem Button ein Speedbutton.

[fox67]

Danke

[fox67]

Hallo
Es ist wieder ein Problem erschienn aber diesmal liegt es an mir ich erkenne den Felher nicht

Delphi-Quellcode:

procedure THaupt.Neufallen;
var
i :integer;
kannbewegen : boolean;
begin


  Form2.Spielfeld.Canvas.Brush.Color := clwhite;
  Form2.Spielfeld.Canvas.Brush.Style := bssolid;
  Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height);
  kannbewegen:= false;
  for i := 0 to high(Block) do
  begin

    if  (i<>high(block)-3) and  (i<>high(block)-2) and (i<>high(block)-1) and (i<>high(block)-0) then
    begin
    if not (Block[high(Block)-3].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-3].fPosition.y +1 <>0) then
    begin
      if not (Block[high(Block)-2].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-2].fPosition.y +1 <>0) then
      begin
        if not (Block[high(Block)-1].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-1].fPosition.y +1 <>0) then
        begin
          if not (Block[high(Block)-0].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-0].fPosition.y +1 <>0) then
          begin
            kannbewegen:= true;
          end;
        end;

      end;

    end;

    end;
  end;


  if kannbewegen then
  begin
  Block[high(Block)-3].fPosition.Y := Block[high(Block)-3].fPosition.Y +1 ;
  Block[high(Block)-2].fPosition.Y := Block[high(Block)-2].fPosition.Y +1 ;
  Block[high(Block)-1].fPosition.Y := Block[high(Block)-1].fPosition.Y +1 ;
  Block[high(Block)].fPosition.Y   := Block[high(Block)].fPosition.Y +1 ;
  end;


  for i := 0 to high(Block) do
    begin
      Block[i].zeichen;
    end;
  if not kannbewegen then neu;

Die Blöcke fallen nicht sondern werden sofort neu erzeugt?

[Bjoerk]

Kumpel, du machst mich echt fertig.

Block[high(Block) - 3].fPosition.Y Das ist sehr unsauber (und geht auch nur, weil TBlock in der selben unit steht). Spendier' TBlock mal eine property X und Y, wie ich‘s dir letztens gezeigt habe.

Deine Schleife wird so auch etwas lesbarer. Was soll die eigentlich machen?

Delphi-Quellcode:

  n := high(Block);
  for i := 0 to n do
    if (i <> n - 3) and (i <> n - 2) and (i <> n - 1) and (i <> n - 0) then
      if (Block[n - 3].y + 1 <> Block[i].y) and (Block[n - 3].y + 1 <> 0) then
        if (Block[n - 2].y + 1 <> Block[i].y) and (Block[n - 2].y + 1 <> 0) then
          if (Block[n - 1].y + 1 <> Block[i].y) and (Block[n - 1].y + 1 <> 0) then
            if (Block[n - 0].y + 1 <> Block[i].y) and (Block[n - 0].y + 1 <> 0) then
               kannbewegen := true;

[Bjoerk]

Achso. Verstehe. Probier' mal so (ungetestet):

Delphi-Quellcode:

function THaupt.CanMoveLast(const deltaX, deltaY: integer): boolean;
var
  N, I, J: integer;
begin
  Result := true;
  N := High(Block);
  for I := 0 to N - 4 do
    for J := 0 to 3 do
      if (Block[N - J].X + deltaX = Block[I].X)
        and (Block[N - J].Y + deltaY = Block[I].Y) then
          Result := false;
end;

[fox67]

Zitat von Bjoerk:

Achso. Verstehe. Probier' mal so (ungetestet):

Delphi-Quellcode:

function THaupt.CanMoveLast(const deltaX, deltaY: integer): boolean;
var
  N, I, J: integer;
begin
  Result := true;
  N := High(Block);
  for I := 0 to N - 4 do
    for J := 0 to 3 do
      if (Block[N - J].X + deltaX = Block[I].X)
        and (Block[N - J].Y + deltaY = Block[I].Y) then
          Result := false;
end;

Vielen Dank. Es funktioniert zwar noch nicht 100% aber das krieg ich noch hin

[fox67]

Zitat von Bjoerk:

Kumpel, du machst mich echt fertig.

Block[high(Block) - 3].fPosition.Y Das ist sehr unsauber (und geht auch nur, weil TBlock in der selben unit steht). Spendier' TBlock mal eine property X und Y, wie ich‘s dir letztens gezeigt habe.

Deine Schleife wird so auch etwas lesbarer. Was soll die eigentlich machen?

Delphi-Quellcode:

  n := high(Block);
  for i := 0 to n do
    if (i <> n - 3) and (i <> n - 2) and (i <> n - 1) and (i <> n - 0) then
      if (Block[n - 3].y + 1 <> Block[i].y) and (Block[n - 3].y + 1 <> 0) then
        if (Block[n - 2].y + 1 <> Block[i].y) and (Block[n - 2].y + 1 <> 0) then
          if (Block[n - 1].y + 1 <> Block[i].y) and (Block[n - 1].y + 1 <> 0) then
            if (Block[n - 0].y + 1 <> Block[i].y) and (Block[n - 0].y + 1 <> 0) then
               kannbewegen := true;

Ja deine Berbesserungsvorschläge hab ich noch nicht umgestetzt da ich erst mal das gröbst zum laufen bringen wollte und dann mir den Code noch einmal anschauen und verbessern.

[fox67]

Tja und leider auch wieder Probleme. Aber wieder ein Denkfehler beim drehen von winkelrechts.
Ich hab das spiel jetzt so um geschrieben das man zum testen nur die Nummer des jeweiligen steins eingeben muss damit es erscheint.
Für die Verbessrungsvorschläge von Thommas hatte ich bis jetzt noch keine Zeit
Winkelrechts = 3

[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.