Tetris mit Canvas funktioniert nicht wie es soll

[fox67]

Das mit dem array funktioniert nicht so recht. Jetzt habe ich das mal mit einer TObjectlist probiert. Eigentlich sollte ich den ganzen code nochmal neuschreiben oder zumindest anpassen aber da ich mir nicht sicher bin ob des so klappt probiere ich es erst mal so.

Delphi-Quellcode:

procedure THaupt.findelinie;
var
x,x2 : TObjectlist;
i,j,tmp : integer;
test : TBlock;

weiter,start : Boolean;

begin
x := Tobjectlist.Create;
x2 := Tobjectlist.create;
weiter := true;
start := false;
for i := 1 to high(Block) do
  begin
    x.Add(Block[i]);
  end;
for j := 1 to 27 do
begin
  if  weiter then  // damit nicht schon die nächste
                  // unterrsucht wird bevor die davor
                  // gelöscht wird    
    begin

    x2.clear;
    x2:= Tobjectlist.Create;
    for i := 0 to x.Count-1 do
     begin
     test := TBlock(x.Items[i]) ;
     if test.fPosition.Y = j  then
     begin
      showmessage(inttostr(j));
      x2.Add(x.items[i]);

       if x2.Count+1 = 16 then
        begin
          weiter := false;
          start := true;
        end;
      end;
     end;
    end;
end;
if start then
begin
  for i := 0 to x2.Count - 1 do
   begin
     tmp := x.IndexOf(x2.Items[i]);
     x.Delete(tmp);
   end;
setlength(Block,x.Count+1);
for i := 1 to x.Count do
  begin
    Block[i] := TBlock(x.Items[i-1]);
  end;
  weiter := true;
  start := false;
  x.Free;
end;
end;

Das funktioniert nur leider nicht es löscht jedesmal etwas aber nicht das was es soll.

[Bjoerk]

Jetzt kannst du auch beim Array bleiben. Das ist ja nicht grundsätzlich schlecht, nur aufwendiger. Und um eine volle Line zu finden braucht man keine zusätzlichen Objectlisten.

Auf die Schnelle:

DeleteBlock und Clear hatten wir schon letztens.
ColCount (Spaltenanzahl) und RowCount(Zeilenanzahl) des Tetris (Spielfeld):

Die Instanz ruft DelFullLines auf.

Delphi-Quellcode:

    THaupt = class
    private
      FColCount, FRowCount : integer;
      ..
      function SamePoint(I, Col, Row: integer): boolean;
      function FullLine(Row: integer): boolean;
      procedure DelLine(Row: integer);
    public
      ..
      procedure DelFullLines;
      constructor Create(AColCount, ARowCount: integer);
      destructor Destroy override;
    end;

constructor THaupt.Create(AColCount, ARowCount: integer);
begin
  inherited;
  FColCount := AColCount;
  FRowCount := ARowCount;
end;

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

function THaupt.SamePoint(I, Col, Row: integer): boolean;
begin
  Result := (Block[I].X = Col) and (Block[I].Y = Row);
end;

function THaupt.FullLine(Row: integer): boolean;
var
  I, Col, Cols: integer;
begin
  Cols := 0;
  for Col := 0 to FColCount - 1 do
    for I := 0 to Length(Block) - 1 do
      if SamePoint(I, Col, Row) then
        Inc(Cols);
  Result := Cols = FColCount;
end;

procedure THaupt.DelLine(Row: integer);
var
  I: integer;
begin
  for I := Length(Block) - 1 downto 0 do
    if Block[I].Y = Row then
      DeleteBlock(I);
  for I := 0 to Length(Block) - 1 do
    if Block[I].Y < Row then
      Block[I].Y := Block[I].Y + 1;
end;

procedure THaupt.DelFullLines;
var
  Row, Rows: integer;
begin
  Rows := 0;
  Row := FRowCount - 1;
  while Row > 0 do
  begin
    if FullLine(Row) 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;