AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Tetris mit Canvas funktioniert nicht wie es soll
Thema durchsuchen
Ansicht
Themen-Optionen

Tetris mit Canvas funktioniert nicht wie es soll

Ein Thema von fox67 · begonnen am 13. Feb 2013 · letzter Beitrag vom 21. Mär 2013
Antwort Antwort
Seite 5 von 5   « Erste     345   
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#41

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 21. Mär 2013, 16:44
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;

Geändert von Bjoerk (21. Mär 2013 um 16:47 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 5 von 5   « Erste     345   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:44 Uhr.
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