unit Snake1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, MMSystem, inifiles, ComCtrls, Buttons, highscore2;
const
farben:
Array [0..3]
of TColor = (clBlack, clLime, clRed, clBlue);
raster = 10;
//10 Pixel = 1 Feld
breite = 24;
//0 bis 24 -> 25 * 10(Raster) = Breite von 250 Pixeln
hoehe = 24;
// ''
type
TForm1 =
class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Timer1: TTimer;
Button6: TButton;
Label1: TLabel;
Image1: TImage;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
Label2: TLabel;
Image2: TImage;
Label3: TLabel;
BitBtn1: TBitBtn;
Label4: TLabel;
GroupBox2: TGroupBox;
BitBtn2: TBitBtn;
BitBtn4: TBitBtn;
Label5: TLabel;
BitBtn3: TBitBtn;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
Label9: TLabel;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure BitBtn1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private-Deklarationen }
//Privater Bereich für Prozeduren die für kein anderes Objekt
//aufgerufen werden und nicht außerhalb der Form benötigt werden.
map:
Array [0..breite]
of Array [0..hoehe]
of Integer;
kopf, richtung, futter: TPoint;
laenge, punkte: Integer;
ende: Boolean;
procedure buttons_freigeben(status: Boolean);
procedure spiel_ende;
procedure neues_futter;
procedure spielfeld;
procedure schlange;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type zaehlertyp =
array [1..1]
of integer;
var einmaligercountdown: zaehlertyp;
procedure InIniSchreiben (Filename, Section, Key, Value:
string);
var ini: Tinifile;
begin
ini:= tinifile.Create(Filename);
try
ini.WriteString(section, key, value);
finally
ini.Free;
end;
end;
function InIniLesen (Filename, Section, Key:
string):
string;
var ini: Tinifile;
begin
ini:= tinifile.Create(Filename);
try
result:= ini.ReadString(section, key, '
');
finally
ini.Free;
end;
end;
procedure Delay (
const Milliseconds: DWord);
var FirstTickCount: DWord;
begin
FirstTickCount:= GetTickCount;
while ((GetTickCount - FirstTickCount) < Milliseconds)
do
begin
Application.ProcessMessages;
Sleep(0);
end;
end;
procedure TForm1.spiel_ende;
begin
ende:= True;
Timer1.Enabled:= False;
buttons_freigeben(False);
Button1.Enabled:= True;
button6.Enabled:= false;
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.spielfeld;
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;
PaintBox1.Canvas.Brush.Color:=col;
PaintBox1.Canvas.FillRect(Rect(i*raster, j*raster, (i+1)*raster, (j+1)*raster));
end;
end;
procedure TForm1.schlange;
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 checkbox1.Checked= true
then
begin
if (kopf.X < 0)
then
Kopf.X:= kopf.X + Breite + 1;
if Kopf.Y < 0
then
Kopf.Y:= kopf.Y + Hoehe + 1;
if Kopf.X > Breite
then
Kopf.X:= Kopf.x - Breite - 1;
if Kopf.Y > Hoehe
then
Kopf.Y:= Kopf.Y - Hoehe - 1;
end
else
if (kopf.X < 0)
or (kopf.X > breite)
or (kopf.Y < 0)
or (kopf.Y > hoehe)
then
begin
spiel_ende;
checkbox1.Enabled:= true;
if label1.Caption > label5.Caption
then
begin
form1.Enabled:= false;
form2.Label3.Caption:= inttostr(punkte-1);
form2.Show;
end
else
showmessage('
Spiel beendet' + #10#13 + '
Du hast den Rand berührt');
if (map[kopf.X, kopf.Y]>0)
and (
not ende)
then
begin
spiel_ende;
checkbox1.Enabled:= true;
if label1.Caption > label5.Caption
then
begin
form1.Enabled:= false;
form2.Label3.Caption:= inttostr(punkte-1);
form2.Show;
end
else
showmessage('
Spiel beendet' + #10#13 + '
Du hadt dich selbst gebissen');
end;
end;
if (kopf.X = futter.X)
and (kopf.Y = futter.Y)
then
begin
Inc(laenge);
neues_futter;
label1.Caption:= inttostr(punkte);
inc(punkte);
end;
map[kopf.X, kopf.Y] := laenge;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i, j, zaehler: Integer;
begin
inc(einmaligercountdown[1]);
label1.Caption:= '
0';
punkte:= 1;
zaehler:= 3;
spielfeld;
label3.Visible:= true;
if einmaligercountdown[1]= 1
then
begin
while zaehler > 0
do
begin
dec(zaehler);
delay(1000);
label3.Caption:= inttostr(zaehler);
end;
end;
Button1.Enabled := False;
button6.Enabled:= true;
checkbox1.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;
buttons_freigeben(True);
ende:= False;
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
schlange;
if not ende
then
spielfeld;
end;
procedure TForm1.FormShow(Sender: TObject);
var filename:
string;
begin
filename:= extractfilepath(application.ExeName)+'
Highscore.ini';
if fileexists(filename)
then
begin
label4.Caption:= InIniLesen(Filename,'
Highscore','
var1') + '
: ';
label5.Caption:= InIniLesen(Filename,'
Highscore','
var2') + '
Punkte';
end
else
begin
InIniSchreiben(Filename, '
Highscore','
var1','
keiner');
InIniSchreiben(Filename, '
Highscore','
var2','
0');
label4.Caption:= InIniLesen(Filename,'
Highscore','
var1') + '
: ';
label5.Caption:= InIniLesen(Filename,'
Highscore','
var2') + '
Punkte';
end;
end;
end.