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.

[fox67]

Delphi-Quellcode:

procedure THaupt.findelinie;
var
i,j,k,max,anzahl : integer;
temp : array[1..16] of integer;

begin
gfblock.Clear;
max := 0;
anzahl := 0;
for i := 1 to high(Block) do
  begin
     if 27-Block[i].fPosition.Y > max then  max := 27-Block[i].fPosition.Y ;


   gfblock.Add(inttostr(Block[i].fPosition.X)+','+inttostr(Block[i].fPosition.y)+','+colortostring(Block[i].ffarbe) );

  end;
for j := 0 to max do
  begin
    for i := 1 to high(Block) do
     begin
        if Block[i].fPosition.Y = j  then
        begin
          anzahl:= anzahl+1;
         temp[anzahl] := i;
        end;
        if anzahl = 16 then
         begin
            gfblock.Move(temp[1],high(Block)-1);
            gfblock.Move(temp[2],high(Block)-2);
            gfblock.Move(temp[3],high(Block)-3);
            gfblock.Move(temp[4],high(Block)-4);
            gfblock.Move(temp[5],high(Block)-5);
            gfblock.Move(temp[6],high(Block)-6);
            gfblock.Move(temp[7],high(Block)-7);
            gfblock.Move(temp[8],high(Block)-8);
            gfblock.Move(temp[9],high(Block)-9);
            gfblock.Move(temp[10],high(Block)-10);
            gfblock.Move(temp[11],high(Block)-11);
            gfblock.Move(temp[12],high(Block)-12);
            gfblock.Move(temp[13],high(Block)-13);
            gfblock.Move(temp[14],high(Block)-14);
            gfblock.Move(temp[15],high(Block)-15);
            gfblock.Move(temp[16],high(Block)-16);
            gfblock.Delete(high(block)-1);
            gfblock.Delete(high(block)-2);
            gfblock.Delete(high(block)-3);
            gfblock.Delete(high(block)-4);
            gfblock.Delete(high(block)-5);
            gfblock.Delete(high(block)-6);
            gfblock.Delete(high(block)-7);
            gfblock.Delete(high(block)-8);
            gfblock.Delete(high(block)-9);
            gfblock.Delete(high(block)-10);
            gfblock.Delete(high(block)-11);
            gfblock.Delete(high(block)-12);
            gfblock.Delete(high(block)-13);
            gfblock.Delete(high(block)-14);
            gfblock.Delete(high(block)-15);
            gfblock.Delete(high(block)-16);
            arraykurzen;
            end
            else neu;

        end;

  end;


end;

procedure THaupt.arraykurzen;
var
sl :  TStringlist;
i : integer;
x,y : integer;
farbe : Tcolor;
begin
setlength(Block,0);
sl := TStringlist.Create;

 for i := 0 to gfblock.Count- 1 do
 begin
   sl.CommaText := gfblock[i];
   x := strtoint(sl[0]);
   y := strtoint(sl[1]);
   farbe := stringtocolor(sl[2]);
   setlength(Block, Length(Block)+1);
   Block[high(Block)].fPosition.X := x;
   Block[high(Block)].fPosition.X := y;
   Block[high(Block)].fFarbe := farbe;
   sl.Clear;
 end;
 findelinie;
end;

Delphi bleibt jedesmal stehen wenn es einen neuen Block erzeugen soll warum?

Thomas ich hab jetzt gemerkt warum eine Liste besser gewesen wäre als eine array

[Sir Rufo]

Entschuldige bitte, aber durch das steigt doch kein Mensch (und Compiler wohl auch nicht) durch.

Eine vernünftige Strukturierung der Programmteile und Daten wäre dringend angebracht

[fox67]

In was soll ich es den Strukturiren die eine Procedure lädt erst die array in eine Stringlist dann wird nach einer reihe gesucht. Wenn gefunden dann werden die Positionen in der Stringlist getauscht so dass man sie anschließend einfach löschen kann. Dann löscht die zweite procedure das array und erzeugt es anschließend neu aus der stringlist.

[Bjoerk]

Was soll denn um Gottes Willen die Stringlist?

Ich hab das Konzept ja von Dir und war damals so begeistert, daß ich es runter programmiert habe. Als ich mit dem Programm dann fertig war ist mir aufgefallen, daß wir es immer nur mir den letzen 4 Blöcken zu tun haben (in meinem Code das Current). Deshalb könnte man statt einer Liste von Blöcken auch einfach ein Spielfeld Array (Zeilen * Spaltenanzahl) mit der FarbInfo verwenden. Das wärs. Mehr braucht man nicht. 4 Blöcke und ein Array (of TColor). Mit dem Array kämst du wahrscheinlich auch sehr viel besser zurecht.

[DeddyH]

Eine TStringlist ist für Strings, deshalb heißt sie ja so. Wenn man etwas anderes da hineinpackt, dann funktioniert das zwar evtl., ist aber trotzdem das falsche Mittel. Ich kann auch mit einer Wasserpumpenzange einen Nagel in die Wand schlagen, nichtsdestotrotz wäre ein Hammer eigentlich besser dafür geeignet. Übrigens baust Du Dir da hübsche Speicherlecks, da die Stringliste immer wieder neu erzeugt, aber niemals freigegeben wird.

[fox67]

Delphi-Quellcode:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons;

type
  TBlock = class;
  THaupt = class;

  TForm2 = class(TForm)
    Spielfeld: TImage;
    Timer1: TTimer;
    Button1: TSpeedButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);


  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  Haupt : THaupt;


  end;

  THaupt = class(TObject)

   Block  : array of TBlock;
   Anzahl : integer;
   kannbewegen : boolean;
   IDs         : Integer;
   procedure Neu();
   procedure Neufallen();
   procedure verschiebenlinks();
   procedure verschiebenrechts();
   procedure findelinie();
   procedure arraykurzen();
  procedure Drehen();
  function CanMoveLast(const deltaX, deltaY: integer): boolean;
  // procedure Prufen();
  // procedure Entfernen();
  private

  public
  zufall: integer;
  gedreht : integer;
  temp : array[1..16] of Integer;
  end;


  TBlock = class(TObject)

    private
    fFarbe    : TColor;
    fPosition : TPoint;
    fID       : Integer;
    public
    procedure zeichen;
    property Farbe : TColor read fFarbe write fFarbe;
    property Position : Tpoint read fPosition write fPosition;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

//Code Block
procedure TBlock.zeichen;
begin
form2.Spielfeld.Canvas.Brush.Color := fFarbe;
form2.Spielfeld.Canvas.Brush.Style := bssolid;
form2.Spielfeld.Canvas.Rectangle(fPosition.X*24, fPosition.Y*24, fPosition.X*24+24, fPosition.Y*24+24 );
end;

//Code Haupt
procedure THaupt.Neu;


begin
 gedreht := 0;
 form2.Timer1.Enabled := false;
  if  (form2.Edit1.text = '') then
   begin
  repeat
  zufall := random(5) +1;
  until (zufall <> 0)  ;

   end
   else
   begin
   try
   zufall := strtoint(form2.Edit1.Text);
    except
    showmessage('keine Zahl');
    repeat
  zufall := random(5) +1;
  until (zufall <> 0)  ;
   end;
   end;

  case zufall of
  1: begin  // Quadrat
      IDs := IDs +4;
      setlength(Block, Length(Block)+4);
      Block[high(Block)-3] := TBlock.Create;
      Block[high(Block)-3].Farbe := clred ;
      Block[high(Block)-3].fPosition.X:= 4   ;
      Block[high(Block)-3].fPosition.Y:= -2  ;
      Block[high(Block)-3].fID := IDS-3;
      Block[high(Block)-2] := TBlock.Create;
      Block[high(Block)-2].Farbe := clred ;
      Block[high(Block)-2].fPosition.X:= 5   ;
      Block[high(Block)-2].fPosition.Y:= -2  ;
      Block[high(Block)-2].fID := IDs-2;
      Block[high(Block)-1] := TBlock.Create;
      Block[high(Block)-1].Farbe := clred ;
      Block[high(Block)-1].fPosition.X:= 4   ;
      Block[high(Block)-1].fPosition.Y:= -1  ;
      Block[high(Block)-1].fID := IDs-1;
      Block[high(Block)] := TBlock.Create;
      Block[high(Block)].Farbe := clred ;
      Block[high(Block)].fPosition.X:= 5   ;
      Block[high(Block)].fPosition.Y:= -1  ;
      Block[high(Block)].fID := IDs;
      //showmessage('Quadrat');
     form2.Timer1.Enabled := true;

     end;

  2: begin  // Winkellinks
      IDs := IDs +4 ;
      setlength(Block, Length(Block)+4);
      Block[high(Block)-3] := TBlock.Create;
      Block[high(Block)-3].Farbe := clyellow ;
      Block[high(Block)-3].fPosition.X:= 4   ;
      Block[high(Block)-3].fPosition.Y:= -2  ;
      Block[high(Block)-3].fID := IDs-3;
      Block[high(Block)-2] := TBlock.Create;
      Block[high(Block)-2].Farbe := clyellow ;
      Block[high(Block)-2].fPosition.X:= 4   ;
      Block[high(Block)-2].fPosition.Y:= -1  ;
      Block[high(Block)-2].fID := IDs-2;
      Block[high(Block)-1] := TBlock.Create;
      Block[high(Block)-1].Farbe := clyellow ;
      Block[high(Block)-1].fPosition.X:= 5   ;
      Block[high(Block)-1].fPosition.Y:= -1  ;
      Block[high(Block)-1].fID := IDs-1;
      Block[high(Block)] := TBlock.Create;
      Block[high(Block)].Farbe := clyellow ;
      Block[high(Block)].fPosition.X:= 6   ;
      Block[high(Block)].fPosition.Y:= -1  ;
      Block[high(Block)].fID := IDs;
       //showmessage('Winkel');
     form2.Timer1.Enabled := true;

     end;

  3: begin      //Winkelrechts
      IDS := IDs +4;
      setlength(Block, Length(Block)+4);
      Block[high(Block)-3] := TBlock.Create;
      Block[high(Block)-3].Farbe := clblue ;
      Block[high(Block)-3].fPosition.X:= 6   ;
      Block[high(Block)-3].fPosition.Y:= -2  ;
      Block[high(Block)-3].fID := IDs-3;
      Block[high(Block)-2] := TBlock.Create;
      Block[high(Block)-2].Farbe := clblue ;
      Block[high(Block)-2].fPosition.X:= 4   ;
      Block[high(Block)-2].fPosition.Y:= -1  ;
      Block[high(Block)-2].fID := IDs-2;
      Block[high(Block)-1] := TBlock.Create;
      Block[high(Block)-1].Farbe := clblue ;
      Block[high(Block)-1].fPosition.X:= 5   ;
      Block[high(Block)-1].fPosition.Y:= -1  ;
      Block[high(Block)-1].fID := IDs-1;
      Block[high(Block)] := TBlock.Create;
      Block[high(Block)].Farbe := clblue ;
      Block[high(Block)].fPosition.X:= 6   ;
      Block[high(Block)].fPosition.Y:= -1  ;
      Block[high(Block)].fID := IDs;
       //showmessage('Winkel');
      form2.Timer1.Enabled := true;

     end;

  4: begin      //T
      IDS := IDs +4;
      setlength(Block, Length(Block)+4);
      Block[high(Block)-3] := TBlock.Create;
      Block[high(Block)-3].Farbe := cllime ;
      Block[high(Block)-3].fPosition.X:= 5   ;
      Block[high(Block)-3].fPosition.Y:= -2  ;
      Block[high(Block)-3].fID := IDs-3;
      Block[high(Block)-2] := TBlock.Create;
      Block[high(Block)-2].Farbe := cllime ;
      Block[high(Block)-2].fPosition.X:= 4   ;
      Block[high(Block)-2].fPosition.Y:= -1  ;
      Block[high(Block)-2].fID := IDs-2;
      Block[high(Block)-1] := TBlock.Create;
      Block[high(Block)-1].Farbe := cllime ;
      Block[high(Block)-1].fPosition.X:= 5   ;
      Block[high(Block)-1].fPosition.Y:= -1  ;
      Block[high(Block)-1].fID := IDs-1;
      Block[high(Block)] := TBlock.Create;
      Block[high(Block)].Farbe := cllime ;
      Block[high(Block)].fPosition.X:= 6   ;
      Block[high(Block)].fPosition.Y:= -1  ;
       //showmessage('T');
      form2.Timer1.Enabled := true;

     end;

  5: begin  // Rechteck
      IDs := IDs +4;
      setlength(Block, Length(Block)+4);
      Block[high(Block)-3] := TBlock.Create;
      Block[high(Block)-3].Farbe := clpurple ;
      Block[high(Block)-3].fPosition.X:= 5   ;
      Block[high(Block)-3].fPosition.Y:= -4  ;
      Block[high(Block)-3].fID := IDs-3;
      Block[high(Block)-2] := TBlock.Create;
      Block[high(Block)-2].Farbe := clpurple ;
      Block[high(Block)-2].fPosition.X:= 5   ;
      Block[high(Block)-2].fPosition.Y:= -3  ;
      Block[high(Block)-2].fID := IDs-2;
      Block[high(Block)-1] := TBlock.Create;
      Block[high(Block)-1].Farbe := clpurple ;
      Block[high(Block)-1].fPosition.X:= 5   ;
      Block[high(Block)-1].fPosition.Y:= -2  ;
      Block[high(Block)-1].fID := IDs-1;
      Block[high(Block)] := TBlock.Create;
      Block[high(Block)].Farbe := clpurple ;
      Block[high(Block)].fPosition.X:= 5   ;
      Block[high(Block)].fPosition.Y:= -1  ;
      Block[high(Block)].fID := IDs;
       //showmessage('REchteck');
       form2.Timer1.Enabled := true;

     end;
  end;



end;

procedure THaupt.Neufallen;
var
i :integer;
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;




 if CanMoveLast(0,1)  then kannbewegen:= true;


  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;

  if (Block[high(Block)-3].fPosition.y = 27) or (Block[high(Block)-2].fposition.y = 27) or (Block[high(Block)-1].fposition.y = 27) or (Block[high(Block)-0].fposition.y = 27) then  kannbewegen:= false;

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

end;

procedure THaupt.Drehen;
begin
 kannbewegen := false;
  case Zufall of
  1: begin
      //passiert nichts

     end;
  2: begin
       case gedreht of
       0: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +0;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y+1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0 ;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
       gedreht := 1;

          end;
       1: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1   ;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y +1;
       gedreht := 2;

          end;
       2 : begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y -0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x     +1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y     +1;
       gedreht := 3;

           end;
       3 : begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2   ;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x +0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
           gedreht := 0;
           end;

        end;
     end;
  3: begin
     case gedreht of
       0: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -0;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0  ;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
       gedreht := 1;

          end;
       1: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1;
       gedreht := 2;

          end;
       2 : begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x + 1   ;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1;
       gedreht := 3;

           end;
       3 : begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0   ;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
           gedreht := 0;
           end;

        end;
     end;
  4: begin
     case gedreht of
       0: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -1;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +1;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
       gedreht := 1;

          end;
       1: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +1;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +1;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1;
       gedreht := 2;

          end;
       2 : begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +1;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -1;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x + 1   ;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1;
       gedreht := 3;

           end;
       3 : begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -1;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -1;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
           gedreht := 0;
           end;

        end;
     end;
  5: begin
     case gedreht of
       0: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x-1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x+1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1;
       gedreht := 1;

          end;
       1: begin
       Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2;
       Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2;
       Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1;
       Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1;
       Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0;
       Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y -0;
       Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1;
       Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1;
       gedreht := 0;

          end;

     end;
  end;
  end;
end;


procedure THaupt.verschiebenlinks;
var
i : Integer;
begin
if  (Block[high(Block)-3].fPosition.x = 0) or (Block[high(Block)-2].fPosition.x = 0) or (Block[high(Block)-1].fPosition.x = 0) or (Block[high(Block)-0].fPosition.x = 0) then
begin

end
else
begin


if canmovelast(-1,0) then
begin

Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.X -1;
Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.X -1;
Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.X -1;
Block[high(Block)-0].fPosition.X:= Block[high(Block)-0].fPosition.X -1;
Form2.Spielfeld.Canvas.Brush.Color := clwhite;
Form2.Spielfeld.Canvas.Brush.Style := bssolid;
Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height);
 for i := 0 to high(Block) do
    begin
      Block[i].zeichen;
    end;
end;
end;
end;

procedure Thaupt.verschiebenrechts;
var
i : Integer;
begin
if  (Block[high(Block)-3].fPosition.x = 15) or (Block[high(Block)-2].fPosition.x = 15) or (Block[high(Block)-10].fPosition.x = 15) or (Block[high(Block)-0].fPosition.x = 15) then
begin

end
else
begin
if canmovelast(1,0) then
begin
Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.X +1;
Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.X +1;
Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.X +1;
Block[high(Block)-0].fPosition.X:= Block[high(Block)-0].fPosition.X +1;
Form2.Spielfeld.Canvas.Brush.Color := clwhite;
Form2.Spielfeld.Canvas.Brush.Style := bssolid;
Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height);
 for i := 0 to high(Block) do
    begin
      Block[i].zeichen;
    end;
end;
end;
end;

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].fPosition.X + deltaX = Block[I].fPosition.X)
         and (Block[N - J].fPosition.y + deltaY = Block[I].fPosition.Y) then
           Result := false;

end;

procedure THaupt.findelinie;
var
i,j,k,max,anzahl : integer;


begin
max := 0;
J := 0;
for i := 1 to high(Block) do
  begin
     if 27-Block[i].fPosition.Y > max then  max := 27-Block[i].fPosition.Y ;
  end;
while (j < max) and (anzahl<>16) do
  begin
    anzahl := 1;
    for i := 1 to high(Block) do
     begin
        if Block[i].fPosition.Y = j+27  then
        begin
         temp[anzahl] := Block[i].fID;
         anzahl:=anzahl+1;
        if anzahl = 16 then
        begin
        arraykurzen
        end
        else
        begin
          neu();
        end;
        end;
     end;
  end;
end;

procedure THaupt.arraykurzen;
var
i,j,x : integer;
begin
for i := 1 to high(Block) do
  begin
    for j := 1 to 16 do
     begin
       if block[i].fID = temp[j] then
        begin
          x := i+1;
          repeat
            Block[x-1].fPosition.X := Block[x].fPosition.x;
            Block[x-1].fPosition.X := Block[x].fPosition.y;
            Block[x-1].fFarbe := Block[x].fFarbe;
            Block[x-1].fID := Block[x].fID;
            x := x+1;
            setlength(Block, length(Block)-1);
          until (x = high(Block)) ;
        end;

     end;

  end;
  findelinie;
end;

//Fenster
procedure TForm2.Button1Click(Sender: TObject);
begin
Haupt.Neu();

end;



procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : integer;
begin

for i := 1 to high(Haupt.Block)  do
begin
Haupt.Block[i].Free;
end;

Haupt.Free;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin

 Haupt := THaupt.Create;
setlength(Haupt.Block, 0);
Haupt.IDs := 0;
end;

procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key = VK_UP then Haupt.Drehen;
if key = VK_left then Haupt.verschiebenlinks;
if key = Vk_right then Haupt.verschiebenrechts;
if key = vk_down then Haupt.Neufallen;




end;


procedure TForm2.Timer1Timer(Sender: TObject);
begin
Haupt.Neufallen();

end;




end.

hab das ganze jetzt geändert. Es tut sich leider aber immer noch nichts

[DeddyH]

Siehe #23, zumindest ich persönlich habe wenig Lust, mich durch den ganzen Code zu quälen. Wieso greift THaupt auf Form2.Canvas zu? Eine Canvas-Property wäre doch viel flexibler. Der ganze DRY-Code in den case-Abfragen könnte auch gekürzt werden, indem man eine Methode zum Ändern der Position etc. einführt und nur noch diese aufruft usw.

[fox67]

Auf form2.canvas wird nie zugegriffen. Nur auf form2.spielfeld.canvas
Spielfeld ist ein TImage

[DeddyH]

Meinetwegen, aber das ändert ja nichts an der Tatsache, dass die THaupt-Klasse auf Form2 zugreift.