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.