Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Hilfe bei Tetris Clon (https://www.delphipraxis.net/162138-hilfe-bei-tetris-clon.html)

Olihorizon 8. Aug 2011 16:49

Hilfe bei Tetris Clon
 
Hallo,

wir müssen bis Mittwoch ein Projekt in Info abgeben. Ich habe mich für einen Tetris Clon entschieden.
Nun zu meinem Problem. Wenn ein Block nach unten wandert, habe ich Schwierigkeiten die untersten Blöcke zu berechnen, ich brauche diese um eine Kollision zu erkennen.

Hat jemand schon Erfahrung, bzw kann mir weiterhelfen?

Delphi-Quellcode:
unit Unit_Tetrix;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Unit_main, Unit_About, jpeg, ExtCtrls, Unit_Highscore, StdCtrls;

type
  Bild = array [0..39] of array [0..24] of TImage;
  Element = Array [0..39,0..24] of boolean;
  zFigur=Array [0..2] of Array [0..1] of integer;
  zFigur2=Array [0..3] of Array [0..1] of integer;
  Figur = array [0..5] of zFigur;
  TF_Tetrix = class(TForm)
    Fr_Main: TFr_Main;
    Fr_About: TFr_About;
    I_Spielfeld: TImage;
    I_Feldelement: TImage;
    I_Menu: TImage;
    Fr_Highscore: TFr_Highscore;
    l_score: TLabel;
    L_score2: TLabel;
    procedure Fr_MainI_AboutClick(Sender: TObject);
    procedure Fr_AboutI_MenuClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Fr_MainI_PlayClick(Sender: TObject);
    procedure Fr_MainI_HighscoreClick(Sender: TObject);
    procedure Fr_MainI_ExitClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_Tetrix: TF_Tetrix;
  Bilder : Bild;
  Elemente : Element;
  i,f:zfigur2;
  reihe:integer;

const
  Figuren : Figur = (((-1,0),(0,1),(-1,1)), //Würfel
                    ((1,0),(1,-1),(2,0)),  //dreieck
                    ((0,1),(0,2),(0,3)),   //Stab
                    ((1,0),(1,-1),(2,-1)), //s
                    ((0,1),(0,2),(1,2)),  //L
                    ((0,1),(0,2),(-1,2))); //falsches L

  Figuren2 : Figur = (((-1,0),(0,1),(-1,1)), //Würfel
                    ((0,-1),(-1,-1),(0,-2)),  //dreieck
                    ((1,0),(2,0),(3,0)),   //Stab
                    ((0,-1),(-1,-1),(-1,-2)), //s
                    ((1,0),(2,0),(2,-1)),  //L
                    ((1,0),(2,0),(2,1))); //falsches L

  Figuren3 : Figur = (((-1,0),(0,1),(-1,1)), //Würfel
                    ((-1,0),(-1,1),(-2,0)),  //dreieck
                    ((0,1),(0,2),(0,3)),   //Stab
                    ((-1,0),(-1,1),(-2,1)), //s
                    ((0,-1),(0,-2),(-1,-2)),  //L
                    ((0,-1),(0,-2),(1,-2))); //falsches L

  Figuren4 : Figur = (((-1,0),(0,1),(-1,1)), //Würfel
                    ((0,1),(1,1),(0,2)),  //dreieck
                    ((1,0),(2,0),(3,0)),   //Stab
                    ((0,1),(1,1),(1,2)), //s
                    ((-1,0),(-2,0),(-2,1)),  //L
                    ((-1,0),(-2,0),(-2,-1))); //falsches L

implementation

{$R *.dfm}


{procedure play(var Bilder : Bild);
var x,y,i : integer;
begin
i:=figur(i);
for x:=0 to 39 do begin
    for y:=0 to 24 do begin
                      if Elemente[x,y]<>0 then Bilder[x][y].Visible:=true;
                      end;
                  end;
end;  }

procedure ubertragen;
var x,y:integer;
begin
for x:=0 to 39 do begin
    for y:=0 to 24 do begin
                      Bilder[x][y].Visible:=Elemente[x,y];
                      end;
                  end;
end;

procedure Delay(Milliseconds: Integer);
var
  Tick: DWord;
  Event: THandle;
begin
  Event := CreateEvent(nil, False, False, nil);
  try
    Tick := GetTickCount + DWord(Milliseconds);
    while (Milliseconds > 0) and
          (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
    begin
      Application.ProcessMessages;
      if Application.Terminated then Exit;
      Milliseconds := Tick - GetTickcount;
    end;
  finally
    CloseHandle(Event);
  end;
end;

function block(x,y:integer; var o:integer): zFigur2;
var i:integer;
    koord : zFigur;
begin
randomize;
i:=random(6)+1;
o:=i;
koord:=Figuren[i-1];
result[0][0]:=y;
result[1][0]:=y+koord[0][0];
result[2][0]:=y+koord[1][0];
result[3][0]:=y+koord[2][0];
result[0][1]:=x;
result[1][1]:=x+koord[0][1];
result[2][1]:=x+koord[1][1];
result[3][1]:=x+koord[2][1];
end;

function drehblock(x,y,d,o:integer): zFigur2;
var i:integer;
    koord : zFigur;
begin
i:=o;
case d of
  0: koord:=Figuren[i-1];
  1: koord:=Figuren2[i-1];
  2: koord:=Figuren3[i-1];
  3: koord:=Figuren4[i-1];
end;
result[0][0]:=y;
result[1][0]:=y+koord[0][0];
result[2][0]:=y+koord[1][0];
result[3][0]:=y+koord[2][0];
result[0][1]:=x;
result[1][1]:=x+koord[0][1];
result[2][1]:=x+koord[1][1];
result[3][1]:=x+koord[2][1];
end;


procedure loeschen(var reihe:integer);
var x,y:integer;
begin
y:=0;
x:=0;
repeat;
repeat;
    if Elemente[x,y]=true then inc(y)
until (y=25) or Elemente[x,y]=false;
if y=25 then for y:=0 to 24 do begin Elemente[x,y]:=false;
                                     inc(reihe);  //Reihen
                               end;
inc(x);
until x=40;
end;

procedure null;
var x,y:integer;
begin
for x:=0 to 39 do begin
    for y:=0 to 24 do begin
                      Elemente[x,y]:=false;
                      end;
                  end;
end;

{procedure TF_Tetrix.formkeydown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var k:zFigur2;
begin
if key=VK_right then begin Elemente[k[0][0],k[0][1]]:=false;
                           Elemente[k[1][0],k[1][1]]:=false;
                           Elemente[k[2][0],k[2][1]]:=false;
                           Elemente[k[3][0],k[3][1]]:=false;
                           inc(k[0][1]);
                           inc(k[1][1]);
                           inc(k[2][1]);
                           inc(k[3][1]);
                           Elemente[k[0][0],k[0][1]]:=true;
                           Elemente[k[1][0],k[1][1]]:=true;
                           Elemente[k[2][0],k[2][1]]:=true;
                           Elemente[k[3][0],k[3][1]]:=true;
                           ubertragen;
                      end;
if key=VK_left then begin Elemente[k[0][0],k[0][1]]:=false;
                           Elemente[k[1][0],k[1][1]]:=false;
                           Elemente[k[2][0],k[2][1]]:=false;
                           Elemente[k[3][0],k[3][1]]:=false;
                           dec(k[0][1]);dec(k[1][1]);dec(k[2][1]);dec(k[3][1]);
                           Elemente[k[0][0],k[0][1]]:=true;
                           Elemente[k[1][0],k[1][1]]:=true;
                           Elemente[k[2][0],k[2][1]]:=true;
                           Elemente[k[3][0],k[3][1]]:=true;
                      end;
//if key=VK_down then
end;   }

procedure play;
var k:zFigur2;
    go:boolean;
    pause,n,z,p,b,dreh,t,m:integer;
    b1,b2,b3,b4:boolean;
    //key,v:word;
begin
n:=9;
go:=false;
pause:=50;
reihe:=0;
repeat //neuer block
//randomize;
//v:=random(23);
k:=block(11,1,b);
dreh:=0;
Elemente[k[0][0],k[0][1]]:=true;      //Block wird angezeigt
Elemente[k[1][0],k[1][1]]:=true;
Elemente[k[2][0],k[2][1]]:=true;
Elemente[k[3][0],k[3][1]]:=true;
ubertragen;
delay(pause);
  repeat //block bewegen bis boden
    Elemente[k[0][0],k[0][1]]:=false;    //Letztes Bild wird gelöscht
    Elemente[k[1][0],k[1][1]]:=false;
    Elemente[k[2][0],k[2][1]]:=false;
    Elemente[k[3][0],k[3][1]]:=false;
    inc(k[0][0]);inc(k[1][0]);inc(k[2][0]);inc(k[3][0]);
    if GetAsyncKeyState(VK_LEFT) <> 0 then
      begin
        dec(k[0][1]);
        dec(k[1][1]);
        dec(k[2][1]);
        dec(k[3][1]);
      end;
    if GetAsyncKeyState(VK_Up) <> 0 then
      begin
       inc(dreh);
       if dreh >= 4 then dreh:=0;
       k:=drehblock(k[0][1],k[0][0],dreh,b);
      end;
    if GetAsyncKeyState(VK_right) <> 0 then
      begin
        inc(k[0][1]);
        inc(k[1][1]);
        inc(k[2][1]);
        inc(k[3][1]);
      end;
    b1:=true;
    b2:=true;
    b3:=true;
    b4:=true;
    m:=0;
    for t:=0 to 3 do //Hier liegt das Problem
      begin
        if k[t][0] > m then m:= k[t][0];
      end;
    if k[0][0] = m then b1:=true;
    if k[1][0] = m then b2:=true;
    if k[2][0] = m then b3:=true;
    if k[3][0] = m then b4:=true;
    Elemente[k[0][0],k[0][1]]:=true;
    Elemente[k[1][0],k[1][1]]:=true;     //neue position wird angezeigt
    Elemente[k[2][0],k[2][1]]:=true;
    Elemente[k[3][0],k[3][1]]:=true;
    ubertragen;
    Delay(pause);
    loeschen(reihe);
    F_tetrix.l_score2.Caption:=inttostr(reihe);
    if reihe>n then begin pause:=pause-40;    //bei 10, 20... reihen schneller
                          n:=n+10;
                    end;
    if n>=59 then pause:=pause+40;
  until (k[0][0] > 38) or (k[1][0] > 38) or (k[2][0] > 38) or (k[3][0] > 38)
  or (b1 and Elemente[k[0][0]+1,k[0][1]]) or (b2 and Elemente[k[0][0]+1,k[1][1]]=true)
  or (b3 and Elemente[k[0][0]+1,k[2][1]]=true) or (b4 and Elemente[k[0][0]+1,k[3][1]]=true);
if Elemente[11,0]=true then go:=true;
until go or Application.Terminated or (k[0][0]=1) or (k[1][0]=1) or (k[2][0]=1) or (k[3][0]=1);
   if not go and not Application.Terminated then showmessage('GameOver');
end;




procedure TF_Tetrix.Fr_MainI_PlayClick(Sender: TObject);
begin
f_Tetrix.BringToFront;
f_Tetrix.I_Spielfeld.Visible:=true;
F_Tetrix.I_Menu.Visible:=true;
f_tetrix.Fr_Main.Visible:=false;
f_tetrix.Fr_About.Visible:=false;
f_tetrix.Fr_Highscore.Visible:=false;
null;
play;
end;

procedure TF_Tetrix.Fr_MainI_AboutClick(Sender: TObject);
begin
F_Tetrix.Fr_About.Memo1.Clear;
F_Tetrix.Fr_About.Memo1.Lines.Add('Steffen Heim'+#13);
F_Tetrix.Fr_About.Memo1.Lines.Add('Trifels-Gymnasium Annweiler'+#13);
F_Tetrix.Fr_About.Memo1.Lines.Add('Informatikkurs Hy 2010/11');
F_Tetrix.fr_about.Visible:=true;
F_Tetrix.fr_about.BringToFront;
F_Tetrix.Fr_Main.Visible:=false;
F_Tetrix.Fr_Highscore.Visible:=false;
end;



procedure TF_Tetrix.Fr_AboutI_MenuClick(Sender: TObject);
begin
F_Tetrix.Fr_Main.Visible:=true;
F_Tetrix.Fr_Main.BringToFront;
F_Tetrix.I_Menu.Visible:=false;
null;
end;



procedure TF_Tetrix.FormCreate(Sender: TObject);
var x,y:integer;
begin
f_tetrix.KeyPreview:=true;
Fr_Main.BringToFront;
for x:=0 to 39 do begin
    for y:=0 to 24 do begin
        Bilder[x][y]:=TImage.Create(self);
        Bilder[x][y].Parent:=self;
        Bilder[x][y].Top:=48+(10*x);
        Bilder[x][y].Left:=112+(10*y);
        Bilder[x][y].Width:=10;
        Bilder[x][y].Height:=10;
        Bilder[x][y].Picture:=I_Feldelement.Picture;
        Bilder[x][y].Visible:=false;
                       end;
                   end;
end;



procedure TF_Tetrix.Fr_MainI_HighscoreClick(Sender: TObject);
begin
fr_about.Visible:=false;
fr_main.Visible:=false;
fr_highscore.Visible:=true;
f_tetrix.I_Menu.Visible:=true;
fr_highscore.BringToFront;
end;

procedure TF_Tetrix.Fr_MainI_ExitClick(Sender: TObject);
begin
Elemente[11,0]:=true;
close;
end;

END.
Danke im Voraus!

Gruß Olihorizon


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:23 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