unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, baseclss, listclss;
type
TForm1 =
class (TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure play;
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
type
TStein =
class (TBase)
private
x,y:integer;
public
constructor create(a,b:integer);
function compare(tb:TBase):integer;
OVERRIDE;
function copy:TBase;
OVERRIDE;
end;
type
TBlock =
class
private
a,b,c,d: TStein;
public
constructor create(w,x,y,z:TStein);
procedure drop;
function iswand(
cc:TStein):boolean;
procedure check;
procedure draw;
procedure right;
procedure left;
end;
var
Form1: TForm1;
Block:TBlock;
Stein:TStein;
SteinListe:TListe;
implementation
{$R *.dfm}
function TStein.compare(tb:TBase):integer;
begin
If x < TStein(tb).x
Then result:=-1;
If x > TStein(tb).x
Then result:=+1;
If y < TStein(tb).y
Then result:=-1;
If y > TStein(tb).y
Then result:=+1;
If (x = TStein(tb).x)
AND (y = TStein(tb).y)
Then result:=0;
end;
constructor TStein.create(a,b:integer);
begin
x:=a;
y:=b;
end;
function TStein.copy:TBase;
begin
result:=TStein.create(x,y);
end;
procedure TBlock.right;
begin
IF (a.x<10)
AND (b.x<10)
AND (c.x<10)
AND (d.x<10)
Then
Begin
If SteinListe.findElem(a.copy)<>
Nil Then begin a:=TStein.create((a.x)+1,(a.y)); SteinListe.update(a.copy);
End;
If SteinListe.findElem(b.copy)<>
Nil Then begin b:=TStein.create((b.x)+1,(b.y)); SteinListe.update(b.copy);
End;
If SteinListe.findElem(c.copy)<>
Nil Then begin c:=TStein.create((c.x)+1,(c.y)); SteinListe.update(c.copy);
End;
If SteinListe.findElem(d.copy)<>
Nil Then begin d:=TStein.create((d.x)+1,(d.y)); SteinListe.update(d.copy);
End;
draw;
end;
End;
Procedure TBlock.left;
Begin
IF (a.x>0)
AND (b.x>0)
AND (c.x>0)
AND (d.x>0)
Then
Begin
If SteinListe.findElem(a.copy)<>
Nil Then begin a:=TStein.create((a.x)-1,(a.y)); SteinListe.update(a.copy);
End;
If SteinListe.findElem(b.copy)<>
Nil Then begin b:=TStein.create((b.x)-1,(b.y)); SteinListe.update(b.copy);
End;
If SteinListe.findElem(c.copy)<>
Nil Then begin c:=TStein.create((c.x)-1,(c.y)); SteinListe.update(c.copy);
End;
If SteinListe.findElem(d.copy)<>
Nil Then begin d:=TStein.create((d.x)-1,(d.y)); SteinListe.update(d.copy);
End;
draw;
end;
End;
constructor TBlock.create(w,x,y,z:TStein);
begin
a:=w; SteinListe.insertlast(w);
b:=x; SteinListe.insertlast(c);
c:=y; SteinListe.insertlast(y);
d:=z; SteinListe.insertlast(z);
end;
procedure TBlock.drop;
begin
While (iswand(a)=false)
AND (iswand(b)=false)
AND (iswand(c)=false)
AND (iswand(d)=false)
Do
Begin
If SteinListe.findElem(a.copy)<>
Nil Then begin a:=TStein.create((a.x),(a.y)+1); SteinListe.update(a.copy);
End;
If SteinListe.findElem(b.copy)<>
Nil Then begin b:=TStein.create((b.x),(b.y)+1); SteinListe.update(b.copy);
End;
If SteinListe.findElem(c.copy)<>
Nil Then begin c:=TStein.create((c.x),(c.y)+1); SteinListe.update(c.copy);
End;
If SteinListe.findElem(d.copy)<>
Nil Then begin d:=TStein.create((d.x),(d.y)+1); SteinListe.update(d.copy);
End;
draw;
sleep(500);
application.processmessages;
End;
check;
end;
function TBlock.iswand(
cc:TStein):boolean;
var bi:TStein;
begin
result:=false;
Bi:=TStein.create(
cc.x,(
cc.y)+1);
If (SteinListe.findelem(bi.copy)<>
NIL)
Then result:=true;
If (bi.y)>12
Then result:=true;
end;
procedure TBlock.check;
var Ai:integer;
function checkone(ac:integer):boolean;
var kx,i : integer; k:TStein;
begin
i:=0;
For kx:=1
to 10
Do
Begin
k:=TStein.create(kx,ac);
If SteinListe.lookUp(k.copy)<>
NIL
Then i:=i+1;
End;
If i=10
Then result:=true
Else result:=false;
End;
procedure dropall;
var k:TStein; xi,yi:integer;
begin
For Yi:=1
to 13
Do
Begin
For Xi:=1
to 10
Do
Begin
k:=TStein.create(xi,yi+1);
If SteinListe.findElem(k.copy)<>
Nil Then SteinListe.update(k.copy);
End;
End;
End;
begin
For Ai:=1
to 13
Do
Begin
If checkone(AI)
Then
Begin
dropall;
draw;
end;
end;
end;
procedure TBlock.draw;
var k:TStein; xi,yi:integer;
begin
For Yi:=1
to 13
Do
Begin
For Xi:=1
to 10
Do
Begin
k:=TStein.create(xi,yi);
If SteinListe.findelem(k.copy)<>
Nil Then Form1.Image1.Canvas.Rectangle((k.x*50)-50,(k.y*50)-50, k.x, k.y);
End;
End;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Canvas.brush.Color:=clblue;
SteinListe:=TListe.create;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
play;
end;
procedure TForm1.play;
begin
randomize;
CASE random(6)
OF
1:
Begin Block:=TBlock.create(TStein.create(4,1),TStein.create(5,1),TStein.create(6,1),TStein.create(6,2))
end;
2:
Begin Block:=TBlock.create(TStein.create(4,1),TStein.create(5,1),TStein.create(6,1),TStein.create(4,2))
end;
3:
Begin Block:=TBlock.create(TStein.create(4,2),TStein.create(5,1),TStein.create(6,1),TStein.create(5,2))
end;
4:
Begin Block:=TBlock.create(TStein.create(4,1),TStein.create(5,1),TStein.create(6,2),TStein.create(5,2))
end;
5:
Begin Block:=TBlock.create(TStein.create(4,2),TStein.create(5,2),TStein.create(6,2),TStein.create(3,2))
end;
0:
Begin Block:=TBlock.create(TStein.create(4,1),TStein.create(5,1),TStein.create(5,2),TStein.create(4,2))
end;
end;
Block.draw;
Block.drop;
Block.draw;
play;
end;
INITIALIZATION
registerclass(TStein);
end.