Delphi-PRAXiS
Seite 5 von 5   « Erste     345   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Tetris mit Canvas funktioniert nicht wie es soll (https://www.delphipraxis.net/173237-tetris-mit-canvas-funktioniert-nicht-wie-es-soll.html)

Bjoerk 21. Mär 2013 15:44

AW: Tetris mit Canvas funktioniert nicht wie es soll
 
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;


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:20 Uhr.
Seite 5 von 5   « Erste     345   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz