unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Timer1: TTimer;
BRechts: TButton;
BLinks: TButton;
BUnten: TButton;
BOben: TButton;
PaintBox1: TPaintBox;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure BObenClick(Sender: TObject);
procedure BLinksClick(Sender: TObject);
procedure BRechtsClick(Sender: TObject);
procedure BUntenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private-Deklarationen }
map:
Array [0..500]
of Array [0..450]
of Integer;
kopf, richtung, futter: TPoint;
laenge: Integer;
ende: Boolean;
procedure spiel_ende;
procedure neues_futter;
procedure paint_map;
procedure calc_snake;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
calc_snake;
if not ende
then
paint_map;
end;
procedure TForm1.spiel_ende;
begin
ende := True;
Timer1.Enabled := False;
BOBen.Enabled := False;
BUnten.Enabled := False;
BLinks.Enabled := False;
BRechts.Enabled := False;
Button1.Enabled := True;
end;
procedure TForm1.neues_futter;
begin
while map[futter.X, futter.Y] <= 0
do
futter := Point(Random(PaintBox1.Width)+1, Random(PaintBox1.Height)+1);
map[futter.X,futter.Y] := -1;
end;
procedure TForm1.paint_map;
var
i,j: Integer;
col: TColor;
begin
for i := 0
to PaintBox1.Width
do
for j := 0
to PaintBox1.Height
do
begin
case map[i,j]
of
-1: col := clyellow;
0: col := clgreen;
else
col := clred;
end;
Paintbox1.Canvas.Brush.Color:= col;
Paintbox1.Canvas.FillRect(Rect(i*7, j*7, (i+1)*7, (j+1)*7));
end;
end;
procedure TForm1.calc_snake;
var
i, j: Integer;
begin
for i := 0
to Paintbox1.Width
do
for j := 0
to Paintbox1.Height
do
if map[i,j]>0
then
Dec(map[i,j]);
Inc(kopf.X, richtung.X);
Inc(kopf.Y, richtung.Y);
if (kopf.X<0)
or (kopf.X>=PaintBox1.Width)
or (kopf.Y<0)
or (kopf.Y>=Paintbox1.Height)
then
begin
spiel_ende;
ShowMessage('
Das Spiel ist zu Ende');
end;
if (map[kopf.X,kopf.Y]>0)
and (
not ende)
then
begin
spiel_ende;
ShowMessage('
Das Spiel ist zu Ende');
end;
if (kopf.X=futter.X)
and (kopf.Y=futter.Y)
then
begin
Inc(laenge);
neues_futter;
end;
map[kopf.X, kopf.Y] := laenge;
end;
procedure TForm1.Button1Click(Sender: TObject);
Var
i,j : Integer;
begin
Button1.Enabled := False;
for i:=0
to Paintbox1.Width
do
for j:=0
to Paintbox1.Height
do
map[i,j] := 0;
kopf := Point(20, 20);
richtung := Point (1,0);
laenge:= 5;
map[kopf.X, kopf.Y] := laenge;
neues_futter;
paint_map;
Timer1.Enabled := True;
BOben.Enabled := True;
BUnten.Enabled := True;
BLinks.Enabled := True;
BRechts.Enabled := True;
ende := False;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Button2.Caption = '
Pause'
then
begin
Timer1.Enabled := False;
Button2.Caption := '
Fortfahren';
exit;
end;
if Button2.Caption = '
Fortfahren'
then
begin
Timer1.Enabled := True;
Button2.Caption := '
Pause';
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Application.Terminate
end;
procedure TForm1.BObenClick(Sender: TObject);
begin
if richtung.Y= 0
then
richtung := Point(0, -1);
end;
procedure TForm1.BLinksClick(Sender: TObject);
begin
if richtung.X= 0
then
richtung := Point(-1, 0);
end;
procedure TForm1.BRechtsClick(Sender: TObject);
begin
if richtung.X= 0
then
richtung := Point(1, 0);
end;
procedure TForm1.BUntenClick(Sender: TObject);
begin
if richtung.Y= 0
then
richtung := Point(0, 1);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Timer1.Interval := 1500;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Timer1.Interval := 1000;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
Timer1.Interval := 10;
end;
end.