unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
const
farben:
Array [0..2]
of TColor=(clWhite, clLime, clRed);
stufen:
Array [0..2]
of Cardinal=(200, 100, 50);
raster = 7;
breite = 65;
hoehe = 45;
type
TForm1 =
class(TForm)
Spielfeld: TPaintBox;
Timer1: TTimer;
BStart: TButton;
BOben: TButton;
BLinks: TButton;
BRechts: TButton;
BUnten: TButton;
PEnde: TButton;
procedure BStartClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BObenClick(Sender: TObject);
procedure BLinksClick(Sender: TObject);
procedure BRechtsClick(Sender: TObject);
procedure BUntenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PEndeClick(Sender: TObject);
private
{ Private-Deklarationen }
map:
Array [0..breite]
of Array [0..hoehe]
of Integer;
kopf,
richtung,
futter: TPoint;
laenge: Integer;
ende,
rand,
gebissen: Boolean;
procedure enable_buttons(status: 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.enable_buttons(status: Boolean);
begin
BOben.Enabled := status;
BRechts.Enabled := status;
BLinks.Enabled := status;
BUnten.Enabled := status;
end;
procedure TForm1.spiel_ende;
begin
ende := True;
Timer1.Enabled := False;
enable_buttons(False);
BStart.Enabled := True;
end;
procedure TForm1.neues_futter;
begin
futter := Point(Random(breite), Random(hoehe));
while map[futter.X, futter.Y]<>0
do
futter := Point(Random(breite), Random(hoehe));
map[futter.X,futter.Y] := -1;
end;
procedure TForm1.paint_map;
var
i, j: Integer;
col: TColor;
begin
for i := 0
to breite
do
for j := 0
to hoehe
do
begin
case map[i, j]
of
-1: col := farben[1];
0: col := farben[0];
else
col := farben[2];
end;
Spielfeld.Canvas.Brush.Color:=col;
Spielfeld.Canvas.FillRect(Rect(i*raster, j*raster, (i+1)*raster, (j+1)*raster));
end;
end;
procedure TForm1.calc_snake;
var
i, j: Integer;
begin
for i := 0
to breite
do
for j := 0
to hoehe
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>breite)
or (kopf.Y<0)
or (kopf.Y>hoehe)
then
begin
spiel_ende;
ShowMessage('
Nicht den Rand berühen!');
end;
if (map[kopf.X, kopf.Y]>0)
and (
not ende)
then
begin
spiel_ende;
ShowMessage('
Nicht in den Schwanz beißen!');
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.BStartClick(Sender: TObject);
var
i, j: Integer;
begin
BStart.Enabled := False;
for i:=0
to breite
do
for j:=0
to hoehe
do
map[i, j] := 0;
kopf := Point(1, 1);
laenge := 5;
richtung := Point(0, 1);
map[kopf.X, kopf.Y] := laenge;
neues_futter;
paint_map;
enable_buttons(True);
ende := False;
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
calc_snake;
if not ende
then
paint_map;
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.FormCreate(Sender: TObject);
begin
Randomize;
end;
procedure TForm1.PEndeClick(Sender: TObject);
begin
halt;
end;
end.