Tetris mit Canvas funktioniert nicht wie es soll

[DeddyH]

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

[fox67]

Warum denn nicht irgent wie muss doch auf das Formular gezeichnet werden

[DeddyH]

Wie schon gesagt: spendiere THaupt eine Property vom Typ TCanvas, auf den diese dann zeichnet. Dann kannst Du Form2.ImageDings.Canvas oder FormBla.Canvas oder was weiß ich zuweisen und bist nicht an Form2 gebunden.

[Sir Rufo]

Zitat von fox67:

Warum denn nicht irgent wie muss doch auf das Formular gezeichnet werden

Aber stell es dir so vor, da fängt jemand an dich zu füttern.
Kein schöner Gedanke. Eben, du kannst das selber, wenn man dir dazu alles an die Hand gibt.

So ist das auch hier.

[fox67]

Ja des mag sein aber mein Problem löst es leider nicht.

[Bjoerk]

Arni, du machst es dir unnötig schwer. Wie findest du denn das Konzept von #25?

[fox67]

Das hört sich zwar deutlich einfacher an aber dann müsste einen großteil neumachen

[Bjoerk]

Übung macht den Meister. Wenn du’s etwas geschickt machst: die GUI 200 Zeilen, die Komponente 300 Zeilen.

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