unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
Trichtung = (Hoch,Runter,Links,Rechts);
TSpielfeld =
class(TForm)
Bild: TImage;
Timer1: TTimer;
Panel1: TPanel;
Label1: TLabel;
m_start: TMemo;
l_start: TLabel;
b_start: TButton;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure b_startClick(Sender: TObject);
end;
tsnake =
class
x,y:
array[1..100]
of integer;
vx,vy,r,laenge:integer;
farbe:tcolor;
richtung:trichtung;
procedure init(fneu:tcolor; xneu, yneu, vxneu, vyneu, rneu:integer);
procedure zeigedich;
procedure bewegedich;
procedure wachsen;
end;
tapfel =
class
x,y,r,score:integer;
farbe:tcolor;
procedure ini;
overload;
procedure ini(fneu:tcolor; xneu, yneu, rneu:integer);
overload;
procedure zeigediche;
procedure fressen;
end;
var
Spielfeld: TSpielfeld;
snake : Tsnake;
apfel : Tapfel;
big : bool;
implementation
{$R *.dfm}
// -------------------------------------------------------------------------- //
// alle Prozeduren, die ausschließlich mit "Snake" zu tun haben
// -------------------------------------------------------------------------- //
procedure tsnake.init(fneu:tcolor; xneu, yneu, vxneu, vyneu, rneu:integer);
begin
laenge:= 1;
farbe:= fneu;
x[laenge] := xneu;
y[laenge] := yneu;
vx := vxneu;
vy := vyneu;
r := rneu;
end;
procedure tsnake.zeigedich;
var i:integer;
begin
Spielfeld.Bild.Canvas.Brush.Color:=Farbe;
for i:=1
to snake.laenge
do
begin
Spielfeld.Bild.Canvas.Rectangle(x[i], y[i], x[i]+2*r, y[i]+2*r);
end;
end;
procedure tsnake.bewegedich;
begin
case snake.richtung
of
Links:
begin //Links
snake.vx:=-1;
snake.vy:= 0;
end;
Hoch:
begin //Hoch
snake.vx:= 0;
snake.vy:= -1;
end;
Rechts:
begin //Rechts
snake.vx:= 1;
snake.vy:= 0;
end;
Runter:
begin //Runter
snake.vx:= 0;
snake.vy:= 1;
end;
end;
//Bewegungsberechnung
x[1] := x[1] + 2*r*vx;
y[1] := y[1] + 2*r*vy;
if (x[1]>Spielfeld.Bild.Width-2*r)
then
begin
x[1] := 0;
end;
if x[1]<0
then
begin
x[1] := Spielfeld.Bild.Width-2*r;
end;
if (y[1] > Spielfeld.Bild.Height-2*r)
then
begin
y[1] := 0;
end;
if y[1] < 0
then
begin
y[1] := Spielfeld.Bild.Height-2*r;
end;
end;
//wachsen
procedure Tsnake.wachsen;
var i:integer;
begin
laenge:= laenge +1;
spielfeld.Label2.Caption:='
Länge : ' + inttostr(laenge);
//Array erweitern
for i:=1
to laenge
do
begin
x[i+1]:=x[i];
y[i+1]:=y[i];
Spielfeld.Bild.Canvas.Rectangle(x[i], y[i], x[i]+2*r, y[i]+2*r);
end;
end;
procedure TSpielfeld.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
case key
of
27:close;
37:
begin //Links
if snake.richtung <> Rechts
then snake.richtung:=Links;
end;
38:
begin //Hoch
if snake.richtung <> Runter
then snake.richtung:=Hoch;
end;
39:
begin //Rechts
if snake.richtung <> Links
then snake.richtung:=Rechts;
end;
40:
begin //Runter
if snake.richtung <> Hoch
then snake.richtung:=Runter;
end;
end;
end;
// -------------------------------------------------------------------------- //
// Alle Prozeduren, die ausschließlich mit "Apfel" zu tun haben
// -------------------------------------------------------------------------- //
procedure tapfel.ini;
begin
farbe:= clGreen;
x := Random(30)*20;
y := Random(20)*20;
r := 10;
end;
procedure tapfel.ini(fneu:tcolor; xneu, yneu, rneu:integer);
begin //
farbe:= fneu;
x := xneu;
y := yneu;
r := rneu;
end;
procedure tapfel.zeigediche;
//
begin
Spielfeld.Bild.Canvas.Brush.Color:=clGreen;
Spielfeld.Bild.Canvas.ellipse(x, y, x+2*r, y+2*r);
end;
procedure tapfel.fressen;
begin
if (x = snake.x[1])
and (y = snake.y[1])
then
begin
score:= score +1;
spielfeld.label1.caption:='
Score : ' + inttostr(score);
apfel.zeigediche;
apfel.ini;
apfel.zeigediche;
big:= true;
end;
end;
// -------------------------------------------------------------------------- //
// Durch diese Prozedur wird das Spiel gestartet und der Anfangsbildschirm ausgeblendet
// -------------------------------------------------------------------------- //
procedure TSpielfeld.b_startClick(Sender: TObject);
begin
l_start.Visible:=false;
b_start.Visible:=false;
m_start.Visible:=false;
panel1.Visible:=true;
bild.Visible:=true;
end;
// -------------------------------------------------------------------------- //
// Diese Prozedur bringt die Bewegungs- und Fressprozeduren in Gang(regelmäßig
// -------------------------------------------------------------------------- //
procedure TSpielfeld.Timer1Timer(Sender: TObject);
begin
//spielfeld.Timer1.Enabled:=false;
//
snake.zeigedich;
snake.bewegedich;
snake.zeigedich;
apfel.fressen;
if big = true
then
begin
snake.wachsen;
big:= false;
end;
//spielfeld.Timer1.Enabled:=true;
end;
// -------------------------------------------------------------------------- //
// Alles was von Anfang an existieren soll ist hier aufgeführt
// -------------------------------------------------------------------------- //
procedure TSpielfeld.FormCreate(Sender: TObject);
begin //
with bild.Canvas
do
begin
pen.Width:=5;
Brush.Color:=clWhite;
Brush.Style:=bsSolid;
Pen.Width:=2;
Pen.Mode:=pmNOTXOR;
Rectangle(0,0,Bild.width,Bild.Height);
end;
snake.init(clRed, Random(30)*20, Random(20)*20,0,0,10);
snake.zeigedich;
apfel.ini;
apfel.zeigediche;
end;
initialization //
randomize;
snake := tsnake.Create;
apfel := tapfel.Create;
big:= false;
end.