unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs, JPEG, XPMan, Menus, MPlayer;
const
raster = 15;
hoehe = 99;
breite = 99;
type
TForm1 =
class(TForm)
Timer1: TTimer;
Button_Start: TButton;
Label1: TLabel;
Label_Apfelanzahl: TLabel;
Panel1: TPanel;
Label4: TLabel;
Label5: TLabel;
ColorDialog_HG: TColorDialog;
ColorDialog_Futter: TColorDialog;
ColorDialog_Schlange: TColorDialog;
ColorDialog_Hindernis: TColorDialog;
Spielfeld: TImage;
MainMenu1: TMainMenu;
Schwierigkeit1: TMenuItem;
Leicht1: TMenuItem;
Mittel1: TMenuItem;
Schwer1: TMenuItem;
Einstellungen1: TMenuItem;
Image1: TImage;
Label_Schlange: TLabel;
N1: TMenuItem;
Beenden1: TMenuItem;
Anleitung1: TMenuItem;
VonSebastianundDennis1: TMenuItem;
Form1: TMenuItem;
Quadrate1: TMenuItem;
Kreise1: TMenuItem;
Farben1: TMenuItem;
Hintergrundfarbe1: TMenuItem;
Futterfarbe1: TMenuItem;
Schlangenfarbe1: TMenuItem;
Hindernisfarbe1: 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
hoehe, breite:Integer;
kopf:TPoint;
richtung:TPoint;
futter:TPoint;
Hindernis:TPoint;
laenge,anzahl:Integer;
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;
map:
Array [0..breite]
of Array [0..hoehe]
of Integer;
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;
col: TColor;
begin
for i:=0
to breite
do
for j:=0
to hoehe
do
begin
case map[i, j]
of
-2: col:=ColorDialog_Hindernis.Color;
-1: col:=ColorDialog_Futter.Color;
0: col:=ColorDialog_HG.Color;
else
col:=ColorDialog_Schlange.Color;
end;
Spielfeld.Canvas.Brush.Color:=col;
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:=col;
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 Weltenscheibe gefallen! '+#13+
'
(Die Schlange wusste nicht, dass die Erde eine Kugel ist.)');
end;
end;
if (map[kopf.X, kopf.Y]>0)
and (
not ende)
then
begin
snake_ende;
ShowMessage('
Du hast dich selbst gebissen! '+#13+'
(Die letzten Gedanken der '+
'
Schlange: '+#13+'
"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+'
(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;
breite:=30;
hoehe:=30;
Spielfeld.Width:=breite*raster;
Spielfeld.Height:=hoehe*raster;
Apfel:=-1;
Button_Start.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;
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;
if MessageDlg('
Möchtest du das Spiel schließen?', mtCustom, [mbYes, mbNo], 0) = mrYes
then
end;
if Key=VK_Space
then
begin
if Timer1.Enabled
then
Timer1.Enabled:=false
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+
'
gehen und bewegt sich langsam.'+#13+
'
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+
'
gehen und bewegt sich schneller.'+#13+
'
Sie wächst doppelt so schnell.'+#13+
'
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+
'
gehen und bewegt sich am schnellsten.'+#13+
'
Sie wächst dreimal so schnell wie üblich.'+#13+
'
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+'
Pfeiltasten = Steuerung'+#13+'
Leertaste = Pause'+#13+'
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
Form1.Close;
end;
end.