Registriert seit: 26. Mai 2008
11 Beiträge
|
Re: Tastendruck abfrage
26. Mai 2008, 17:40
Es soll ein auf Canvas basierendes Tetris werden (Nicht mit Lines-Abbau sondern mit Zeit).
Ich kann es ja mal Hochlanden, falls es fertig wird. Hier jedenfalls erstmal der schlecht sortierte Code.
Niveau ist nicht so hoch(nur Schulprojekt).
Delphi-Quellcode:
...
var
zblock1,zblock2,over,unten,runter,timer2z,test,spielaktiv,winkel:integer;
key:word;
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.EndeClick(Sender: TObject);
begin
close;
end;
procedure TForm1.NeuClick(Sender: TObject);
begin
spielaktiv:=1;
with canvas do
begin
brush.Style:=bsclear;
font.Height:=25;
font.color:=clskyblue;
TextOut(400,180,'Score:');
TextOut(400,280,'Lines:');
TextOut(400,380,'Level:');
brush.Style:=bssolid;
brush.color:=clblack;
pen.Color:=clwhite;
rectangle(380,15,530,165);
end;
runter:=0;
test:=0;
winkel:=0;
timer1.Enabled:=true;
timer3.Enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
randomize;
canvas.Pen.Style:=psclear;
zblock1:=random(7)+1;
zblock2:=random(7)+1;
test:=test+1;
timer2.enabled:=true;
if (test=10) or (over=1) then
timer1.Enabled:=false;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
runter:=runter+1;
timer1.Enabled:=false;
case zblock1 of
1:begin {langes}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(114,-10+(runter-1)*30,234,21+(runter-1)*30);
Brush.color:=clmaroon;
rectangle(114,-10+(runter)*30,234,20+(runter)*30);
end;
end;
2:begin {L umgekehrt}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(114,-11+(runter-1)*30,204,21+(runter-1)*30);
Brush.color:=clred;
rectangle(114,-10+(runter)*30,204,20+(runter)*30);
rectangle(174,19+(runter)*30,204,50+(runter)*30);
end;
end;
3:begin {L}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(114,-11+(runter-1)*30,204,21+(runter-1)*30);
Brush.color:=clwhite;
rectangle(114,-10+(runter)*30,204,20+(runter)*30);
rectangle(114,19+(runter)*30,144,50+(runter)*30);
end;
end;
4:begin {stufe liegend rechts=oben}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(114,-11+(runter-1)*30,204,21+(runter-1)*30);
rectangle(114,19+(runter-1)*30,204,51+(runter-1)*30);
Brush.color:=cllime;
rectangle(144,-10+(runter)*30,204,20+(runter)*30);
rectangle(114,19+(runter)*30,174,50+(runter)*30);
end;
end;
5:begin {stufe liegend rechts=unten}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(114,-11+(runter-1)*30,204,21+(runter-1)*30);
rectangle(174,19+(runter-1)*30,204,51+(runter-1)*30);
Brush.color:=claqua;
rectangle(114,-10+(runter)*30,174,20+(runter)*30);
rectangle(144,19+(runter)*30,204,50+(runter)*30);
end;
end;
6:begin {3zack}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(114,-11+(runter-1)*30,204,21+(runter-1)*30);
Brush.color:=clsilver;
rectangle(114,-10+(runter)*30,204,20+(runter)*30);
rectangle(144,19+(runter)*30,174,50+(runter)*30);
end;
end;
7:begin {Block}
with canvas do
begin
Brush.color:=clblack;
if runter=1 then else
rectangle(144,-11+(runter-1)*30,204,21+(runter-1)*30);
Brush.color:=clwhite;
rectangle(144,-10+(runter)*30,204,50+(runter)*30);
end;
end;
end;
if runter=15 then
begin
runter:=0;
timer1.enabled:=true;
timer2.Enabled:=false;
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ((spielaktiv > 0) or (not(spielaktiv > 0) and (key <> 27))) then exit;
case key of
{Escape} VK_ESCAPE: close;
{left} VK_LEFT : ;
{up} VK_UP : ;
{right} VK_RIGHT : ;
{bottom} VK_DOWN : ;
end;
end;
end.
sooo
Ich mach nebenbei schonmal weiter. fehlt noch einiges (Drehen, Kollisionsabfrage etc.)
Bis dann
EDIT: Einiges ist auch noch so programmiert, dass es nur einige Testdurchläufe macht
|