AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Hilfe bei Tetris Clon

Ein Thema von Olihorizon · begonnen am 8. Aug 2011
Antwort Antwort
Olihorizon

Registriert seit: 8. Aug 2011
1 Beiträge
 
#1

Hilfe bei Tetris Clon

  Alt 8. Aug 2011, 17:49
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
  Mit Zitat antworten Zitat
Antwort Antwort


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 18:28 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