unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs, JPEG, XPMan, Menus;
const
raster = 15;
hoehe = 30;
breite = 30;
type
TForm1 =
class(TForm)
Timer1: TTimer;
Button_Start: TButton;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label_Apfelanzahl: TLabel;
Label_Schlange: TLabel;
ColorDialog_HG: TColorDialog;
ColorDialog_Futter: TColorDialog;
ColorDialog_Schlange: TColorDialog;
ColorDialog_Hindernis: TColorDialog;
Spielfeld: TImage;
Image1: TImage;
MainMenu1: TMainMenu;
Schwierigkeit1: TMenuItem;
Leicht1: TMenuItem;
Mittel1: TMenuItem;
Schwer1: TMenuItem;
Einstellungen1: TMenuItem;
Schlangenform1: TMenuItem;
Quadrate1: TMenuItem;
Kreise1: TMenuItem;
Farben1: TMenuItem;
Hintergrundfarbe1: TMenuItem;
Futterfarbe1: TMenuItem;
Schlangenfarbe1: TMenuItem;
Hindernisfarbe1: TMenuItem;
N1: TMenuItem;
Beenden1: TMenuItem;
Anleitung1: TMenuItem;
VonSebastianundDennis1: TMenuItem;
procedure Button_StartClick (Sender: TObject);
procedure Timer1Timer (Sender: TObject);
procedure FormCreate (Sender: TObject);
procedure FormKeyDown (Sender: TObject;
var Key: Word;Shift: TShiftState);
procedure Leicht1Click (Sender: TObject);
procedure Mittel1Click (Sender: TObject);
procedure Schwer1Click (Sender: TObject);
procedure Quadrate1Click (Sender: TObject);
procedure Kreise1Click (Sender: TObject);
procedure Anleitung1Click (Sender: TObject);
procedure Futterfarbe1Click (Sender: TObject);
procedure Hintergrundfarbe1Click(Sender: TObject);
procedure Hindernisfarbe1Click (Sender: TObject);
procedure Schlangenfarbe1Click (Sender: TObject);
procedure Beenden1Click (Sender: TObject);
private
map:
Array [0..breite]
of Array [0..hoehe]
of Integer;
kopf, richtung, futter, Hindernis:TPoint;
laenge, anzahl, apfel:Integer;
ende:Boolean;
procedure snake_ende;
procedure snake_futter;
procedure neue_hindernisse(anzahl:Integer);
procedure paint_map;
procedure calc_snake;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.snake_ende;
begin
ende:=True;
Timer1.Enabled:=False;
Button_Start.Enabled:=True;
end;
procedure TForm1.snake_futter;
begin
Inc(apfel);
Label_Apfelanzahl.Refresh;
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.neue_hindernisse(anzahl:Integer);
var
I:Integer;
begin
for I:=0
to anzahl-1
do
begin
Hindernis:=Point(Random(breite), Random(hoehe));
map[Hindernis.X,Hindernis.Y]:=-2;
end;
end;
procedure TForm1.paint_map;
var
i, j: Integer;
farbe: TColor;
begin
for i:=0
to breite
do
for j:=0
to hoehe
do
begin
case map[i, j]
of
-2: farbe:=ColorDialog_Hindernis.Color;
-1: farbe:=ColorDialog_Futter.Color;
0: farbe:=ColorDialog_HG.Color;
else
farbe:=ColorDialog_Schlange.Color;
end;
Spielfeld.Canvas.Brush.Color:=farbe;
if Kreise1.Checked
then
begin
Spielfeld.Canvas.Brush.Color:=ColorDialog_HG.Color;
Spielfeld.Canvas.FillRect(Rect(i*raster, j*raster, (i+1)*raster, (j+1)*raster));
Spielfeld.Canvas.Brush.Color:=farbe;
Spielfeld.Canvas.Ellipse(Rect(i*raster, j*raster, (i+1)*raster, (j+1)*raster));
end
else
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 Leicht1.Checked
then
begin
if kopf.X<0
then
kopf.X:=breite;
if kopf.X>breite
then
kopf.X:=0;
if kopf.Y<0
then
kopf.Y:=hoehe;
if kopf.Y>hoehe
then
kopf.Y:=0;
end
else
begin
if (kopf.X<0)
or (kopf.X>breite)
or (kopf.Y<0)
or (kopf.Y>hoehe)
then
begin
snake_ende;
ShowMessage('
Du bist von der Welt gefallen! '+#13#10+
'
Ist die Erde nicht eine Kugel?');
end;
end;
if (map[kopf.X, kopf.Y]>0)
and (
not ende)
then
begin
snake_ende;
ShowMessage('
Du hast dich selbst gebissen!'+#13#10+
'
Bin ich eigentlich eine Giftschlange?');
end;
if (kopf.X=futter.X)
and (kopf.Y=futter.Y)
then
begin
if Schwer1.Checked
then
laenge:=laenge+3;
if Mittel1.Checked
then
laenge:=laenge+2;
if Leicht1.Checked
then
Inc(laenge);
snake_futter;
end;
if (map[kopf.X, kopf.Y]=-2)
and (
not ende)
then
begin
snake_ende;
ShowMessage('
Du bist gegen ein Hindernis gelaufen! '+#13#10+'
Vielleicht '+
'
wärst du besser eine Brillenschlange geworden!');
end;
map[kopf.X, kopf.Y]:=laenge;
Label_Schlange.Caption:=IntToStr(laenge);
Label_Apfelanzahl.Caption:=IntToStr(apfel);
end;
procedure TForm1.Button_StartClick(Sender: TObject);
var
i, j: Integer;
begin
Spielfeld.Refresh;
Label_Apfelanzahl.Refresh;
Spielfeld.Width:=breite*raster;
Spielfeld.Height:=hoehe*raster;
Button_Start.Enabled:=False;
for i:=0
to breite
do
for j:=0
to hoehe
do
map[i, j]:=0;
kopf:=Point(0, 15);
laenge:=6;
apfel :=-1;
richtung:=Point(1, 0);
map[kopf.X, kopf.Y]:=laenge;
snake_futter;
paint_map;
ende:=False;
Timer1.Enabled:=true;
neue_hindernisse(anzahl);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
calc_snake;
if not ende
then
paint_map;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HintHidePause:=4000;
Spielfeld.Height:=1000;
Spielfeld.Width:=1000;
Randomize;
end;
procedure TForm1.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if Key=VK_right
then
if richtung.X=0
then
begin
richtung:=Point(1, 0)
end;
if Key=VK_left
then
if richtung.X=0
then
richtung:=Point(-1, 0);
if Key=VK_up
then
if richtung.Y=0
then
richtung:=Point(0, -1);
if Key=VK_down
then
if richtung.Y=0
then
richtung:=Point(0, 1);
if Key=VK_Escape
then
begin
snake_ende;
Showmessage('
Die Runde ist beendet')
end;
if Key=VK_Space
then
begin
if Timer1.Enabled
then
begin
Timer1.Enabled:=false;
Button_Start.Enabled:=true
end
else
Timer1.Enabled:=true;
end;
end;
procedure TForm1.Leicht1Click(Sender: TObject);
begin
anzahl:=0;
timer1.Interval:=135;
Leicht1.Checked:=true;
ShowMessage('
Die Schlange kann durch Wände '+#13#10+
'
gehen und bewegt sich langsam.'+#13#10+
'
Es erscheinen keine Hindernisse.');
end;
procedure TForm1.Mittel1Click(Sender: TObject);
begin
anzahl:=10;
timer1.Interval:=100;
Mittel1.Checked:=true;
ShowMessage('
Die Schlange kann nicht durch Wände '+#13#10+
'
gehen und bewegt sich schneller.'+#13#10+
'
Sie wächst doppelt so schnell.'+#13#10+
'
Es erscheinen 10 Hindernisse.');
end;
procedure TForm1.Schwer1Click(Sender: TObject);
begin
anzahl:=20;
timer1.Interval:=50;
Schwer1.Checked:=true;
ShowMessage('
Die Schlange kann nicht durch Wände '+#13#10+
'
gehen und bewegt sich am schnellsten.'+#13#10+
'
Sie wächst dreimal so schnell wie üblich.'+#13#10+
'
Es erscheinen 20 Hindernisse.');
end;
procedure TForm1.Quadrate1Click(Sender: TObject);
begin
Quadrate1.Checked:=true;
end;
procedure TForm1.Kreise1Click(Sender: TObject);
begin
Kreise1.Checked:=true;
end;
procedure TForm1.Anleitung1Click(Sender: TObject);
begin
ShowMessage('
Anleitung'+#13#10+'
Pfeiltasten = Steuerung'+#13#10+'
Leertaste = Pause'+#13#10+'
Esc = Beenden');
end;
procedure TForm1.Futterfarbe1Click(Sender: TObject);
begin
ColorDialog_Futter.Execute;
end;
procedure TForm1.Hintergrundfarbe1Click(Sender: TObject);
begin
ColorDialog_HG.Execute;
end;
procedure TForm1.Hindernisfarbe1Click(Sender: TObject);
begin
ColorDialog_Hindernis.Execute;
end;
procedure TForm1.Schlangenfarbe1Click(Sender: TObject);
begin
ColorDialog_Schlange.Execute;
end;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
snake_ende;
if MessageDlg('
Möchtest du das Spiel schließen?', mtCustom, [mbYes, mbNo], 0) = mrYes
then
Close
else
Timer1.Enabled:=true;
end;
end.