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;
Langsam = 250;
Mittel = 100;
Schnell = 50;
type
TForm1 =
class(TForm)
Spielfeld: TPaintBox;
Timer1: TTimer;
BStart: TButton;
BOben: TButton;
BLinks: TButton;
BRechts: TButton;
BUnten: TButton;
PEnde: TButton;
BPause: TButton;
BWeiter: TButton;
PLeicht: TButton;
PSchwer: TButton;
PMittel: TButton;
Label1: TLabel;
Label2: TLabel;
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);
procedure BPauseClick(Sender: TObject);
procedure BWeiterClick(Sender: TObject);
procedure PLeichtClick(Sender: TObject);
procedure PMittelClick(Sender: TObject);
procedure PSchwerClick(Sender: TObject);
procedure BRechtsKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
private
{ Private-Deklarationen }
map:
Array [0..breite]
of Array [0..hoehe]
of Integer;
kopf,
richtung,
punkt: TPoint;
punkte: Integer;
laenge: Integer;
ende,
rand,
gebissen: Boolean;
procedure enable_buttons(status: Boolean);
procedure spiel_ende;
procedure neuer_punkt;
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;
BPause.Enabled := status;
BWeiter.Enabled := status;
PLeicht.Enabled := status;
PMittel.Enabled := status;
PSchwer.Enabled := status;
end;
procedure TForm1.spiel_ende;
begin
ende := True;
Timer1.Enabled := False;
BPause.Enabled:=False;
BWeiter.Enabled:=False;
PLeicht.Enabled:=False;
PMittel.Enabled:=False;
PSchwer.Enabled:=False;
enable_buttons(False);
BStart.Enabled := True;
end;
procedure TForm1.neuer_punkt;
begin
punkt := Point(Random(breite), Random(hoehe));
while map[punkt.X, punkt.Y]<>0
do
punkt := Point(Random(breite), Random(hoehe));
map[punkt.X,punkt.Y] := -1;
end;
procedure TForm1.paint_map;
var
i, j: Integer;
color: TColor;
begin
for i := 0
to breite
do
for j := 0
to hoehe
do
begin
case map[i, j]
of
-1: color := farben[1];
0: color := farben[0];
else
color := farben[2];
end;
Spielfeld.Canvas.Brush.Color:=color;
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!');
ShowMessage('
Du hast '+IntToStr(punkte)+'
Punkte erreicht')
end;
if (map[kopf.X, kopf.Y]>0)
and (
not ende)
then
begin
spiel_ende;
ShowMessage('
Nicht in den Schwanz beißen!');
ShowMessage('
Du hast '+IntToStr(punkte)+'
Punkte erreicht')
end;
if (kopf.X=punkt.X)
and (kopf.Y=punkt.Y)
then
begin
Inc(laenge);
neuer_punkt;
if Timer1.Interval = Langsam
then
Punkte := Punkte + 3
else
if Timer1.Interval = Mittel
then
Punkte := Punkte + 8
else
if Timer1.Interval = Schnell
then
Punkte := Punkte + 12;
end;
map[kopf.X, kopf.Y] := laenge;
Label2.Caption := '
Aktueller Punktestand: ' + IntToStr(Punkte);
end;
procedure TForm1.BStartClick(Sender: TObject);
var
i, j: Integer;
begin
punkte:=0;
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;
neuer_punkt;
paint_map;
enable_buttons(True);
ende := False;
Timer1.Enabled := true;
Timer1.Interval := Mittel;
Form1.PLeicht.Visible:=false;
Form1.PMittel.Visible:=false;
Form1.PSchwer.Visible:=true;
Form1.BOben.Visible:=true;
Form1.BLinks.Visible:=true;
Form1.BRechts.Visible:=true;
Form1.BUnten.Visible:=true;
Form1.BPause.Visible:=true;
Form1.BWeiter.Visible:=false;
Form1.Label1.Visible:=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;
procedure TForm1.BPauseClick(Sender: TObject);
begin
Timer1.Enabled := False;
Form1.BPause.Visible:=false;
Form1.BWeiter.Visible:=true;
PLeicht.Enabled:=False;
PMittel.Enabled:=False;
PSchwer.Enabled:=False;
BOben.Enabled:=False;
BLinks.Enabled:=False;
BRechts.Enabled:=False;
BUnten.Enabled:=False;
end;
procedure TForm1.BWeiterClick(Sender: TObject);
begin
Timer1.Enabled := True;
Form1.BPause.Visible:=true;
Form1.BWeiter.Visible:=false;
PLeicht.Enabled:=true;
PMittel.Enabled:=true;
PSchwer.Enabled:=true;
BOben.Enabled:=true;
BLinks.Enabled:=true;
BRechts.Enabled:=true;
BUnten.Enabled:=true;
end;
procedure TForm1.PLeichtClick(Sender: TObject);
begin
Timer1.Interval := Langsam;
calc_snake;
if not ende
then
paint_map;
Form1.PLeicht.Visible:=false;
Form1.PMittel.Visible:=true;
Form1.PSchwer.Visible:=false;
end;
procedure TForm1.PMittelClick(Sender: TObject);
begin
Timer1.Interval := Mittel;
calc_snake;
if not ende
then
paint_map;
Form1.PLeicht.Visible:=false;
Form1.PMittel.Visible:=false;
Form1.PSchwer.Visible:=true;
end;
procedure TForm1.PSchwerClick(Sender: TObject);
begin
Timer1.Interval := Schnell;
calc_snake;
if not ende
then
paint_map;
Form1.PLeicht.Visible:=true;
Form1.PMittel.Visible:=false;
Form1.PSchwer.Visible:=false;
end;
procedure TForm1.BRechtsKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
case Key
of
VK_RIGHT: BRechtsClick(self);
end;
end;
end.