unit Snake;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IniFiles;
type
TSnake =
class(TObject)
private
// Private Deklaration
rTeile:
array[0..40*30-1]
of TPoint;
rAnzahlTeile: Word;
rCanvas: TCanvas;
// Für die Richtung wird Byte verwendet, da es nur vier Richtungen gibt
// in denen sich die Schlange bewegen kann
rRichtung: Byte;
// Damit wird eine sofortige Aenderung der Richtung der Schlange unterbunden
rWurdeBewegt: Boolean;
function LiesTeil(
Index: Word): TPoint;
function PruefeObTot(): Boolean;
procedure AendereRichtung(NeueRichtung: Byte);
public
// Öffentliche Deklaration
property Teile[
Index: Word]: TPoint
read LiesTeil;
property AnzahlTeile: Word
read rAnzahlTeile;
property Canvas: TCanvas
read rCanvas
write rCanvas;
property Richtung: Byte
read rRichtung
write AendereRichtung;
property IstTot: Boolean
read PruefeObTot;
procedure Init();
procedure Render();
procedure Update();
procedure Wachse();
end;
TFmMain =
class(TForm)
RenderingTimer: TTimer;
pStatus: TPanel;
lblPunkte: TLabel;
lblScore: TLabel;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure RenderingTimerTimer(Sender: TObject);
procedure FormKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
private
{ Private-Deklarationen }
Schlange: TSnake;
Haeppchen: TPoint;
Pause: Boolean;
Origianl: TBitMap;
Gerendert: TBitMap;
procedure SetzeHaeppchen();
procedure LadeBilder();
public
{ Public-Deklarationen }
end;
var
FmMain: TFmMain;
implementation
{$R *.dfm}
{ TSnake }
// Snake Bereich
// Teil X an Stelle Index zurückgeben
function TSnake.LiesTeil(
Index: Word): TPoint;
begin
Result := rTeile[
Index];
end;
function TSnake.PruefeObTot: Boolean;
// Ist Schlange tot?
var
Index: Word;
begin
// Pruefe ob eines der Teile die gleichen Koordinaten hat,
// wenn Ja -> Schlange tot
for Index := 1
to rAnzahlTeile
do
begin
if (rTeile[0].X = rTeile[
Index].X)
and (rTeile[0].Y = rTeile[
Index].Y)
then
begin
Result := True;
Exit;
end;
end;
// Prüfe ob Wände erreicht
if (rTeile[0].Y < 0)
or (rTeile[0].Y > 39)
or
(rTeile[0].X < 0)
or (rTeile[0].X > 52)
then
begin
Result := True;
Exit;
end;
Result := False;
end;
// Snake zurücksetzen
procedure TSnake.Init;
begin
rAnzahlTeile := 5;
rTeile[0] := Point(5, 0);
rTeile[1] := Point(4, 0);
rTeile[2] := Point(3, 0);
rTeile[3] := Point(2, 0);
rTeile[4] := Point(1, 0);
rTeile[5] := Point(0, 0);
// Es wird immer mit der Richtung "rechts" gestartet
rRichtung := 3;
rWurdeBewegt := True;
end;
// Rendering
procedure TSnake.Render;
var
Index: Word;
StartX, StartY: integer;
EndeX, EndeY: integer;
begin
// Farbe der Schlange
rCanvas.Pen.Color := clYellow;
rCanvas.Brush.Color := clBlack;
// Körperteile der Schlange zeichnen
for Index := 0
to rAnzahlTeile
do
begin
if Index > 0
then
begin
rCanvas.Pen.Color := clBlack;
rCanvas.Brush.Color := clYellow;
end;
StartX := (rTeile[
Index].X) * 12;
EndeX := ((rTeile[
Index].X) * 12) + 12;
StartY := (rTeile[
Index].Y) * 12;
EndeY := ((rTeile[
Index].Y) * 12) + 12;
rCanvas.RoundRect(StartX, StartY, EndeX, EndeY, 5, 5);
end;
end;
procedure TSnake.Update();
var
Index: Word;
begin
for Index := rAnzahlTeile
downto 1
do
begin
rTeile[
Index] := rTeile[
Index-1];
end;
case rRichtung
of
0:
begin
// hoch
rTeile[0].Y := rTeile[0].Y - 1;
rWurdeBewegt := True;
end;
1:
begin
// runter
rTeile[0].Y := rTeile[0].Y + 1;
rWurdeBewegt := True;
end;
2:
begin
// links
rTeile[0].X := rTeile[0].X - 1;
rWurdeBewegt := True;
end;
3:
begin
// rechts
rTeile[0].X := rTeile[0].X + 1;
rWurdeBewegt := True;
end;
end;
end;
procedure TSnake.Wachse;
// Körpergröße + 1
var
TempScore: Integer;
begin
rAnzahlTeile := Succ(rAnzahlTeile);
//Punkte hochzählen
TempScore := StrToInt(FmMain.lblScore.Caption) + (3
mod 36);
fmmain.lblScore.Caption := IntToStr(TempScore);
end;
procedure TSnake.AendereRichtung(NeueRichtung: Byte);
begin
if not rWurdeBewegt
then Exit;
case rRichtung
of
0, 1:
begin
// Wenn in die eigene oder engegengesetzte Richtung geaendert wird,
// dann verlasse Routine (Oben Unten)
if NeueRichtung = 0
then Exit;
if NeueRichtung = 1
then Exit;
end;
2, 3:
begin
// Wenn in die eigene oder engegengesetzte Richtung geaendert wird,
// dann verlasse Routine (Links Rechts)
if NeueRichtung = 2
then Exit;
if NeueRichtung = 3
then Exit;
end;
end;
// Zuweisen;
rRichtung := NeueRichtung;
rWurdeBewegt := False;
end;
// Fenterbereich
procedure TFmMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
// Speicherplatz wieder freigeben
Schlange.Free;
Origianl.Free;
Gerendert.Free;
end;
procedure TFmMain.FormCreate(Sender: TObject);
begin
// Behebt störendes Flimmern
Self.DoubleBuffered := True;
Origianl := TBitmap.Create;
Gerendert := TBitmap.Create;
Gerendert.Width := 640;
Gerendert.Height := 480;
// Klassenobjekt erzeugen
Schlange := TSnake.Create;
// Form Canvas der Klasseneigenschaft Canvas zuweisen
Schlange.Canvas := Gerendert.Canvas;
// Klasse initialisieren
Schlange.Init();
LadeBilder();
SetzeHaeppchen();
// Pause
Pause := True;
end;
procedure TFmMain.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if not Pause
then
begin
if Key = VK_UP
then Schlange.Richtung := 0;
if Key = VK_DOWN
then Schlange.Richtung := 1;
if Key = VK_LEFT
then Schlange.Richtung := 2;
if Key = VK_RIGHT
then Schlange.Richtung := 3;
end;
// Pause ermöglichen
if Key = VK_SPACE
then Pause :=
not Pause;
end;
procedure TFmMain.LadeBilder;
begin
try
Origianl.LoadFromResourceName(HInstance, '
Hintergrund');
except
Origianl.Canvas.Brush.Color := clWhite;
Origianl.Canvas.Pen.Color := clWhite;
Origianl.Width := 640;
Origianl.Height := 480;
end;
end;
procedure TFmMain.RenderingTimerTimer(Sender: TObject);
begin
if Pause
then
Self.Caption := '
Snake - PAUSIERT'
else
Self.Caption := '
Snake';
// Hintergrund zeichnen
Gerendert.Canvas.Draw(0, 0, Origianl);
// Rotes Haeppchen zeichnen
Gerendert.Canvas.Pen.Color := clWhite;
Gerendert.Canvas.Brush.Color := clRed;
Gerendert.Canvas. Ellipse(Haeppchen.X * 12,
Haeppchen.Y * 12,
Haeppchen.X * 12 + 12,
Haeppchen.Y * 12 + 12);
// Bewegung
if not (Pause)
then Schlange.Update();
// Rendern
Schlange.Render();
Canvas.Draw(0, 0, Gerendert);
// Pruefe ob die Schlange tot ist
if (Schlange.IstTot)
then
begin
RenderingTimer.Enabled := False;
MessageDlg('
Game Over! Erzielter Punktestand: ' + lblScore.Caption + '
!', mtInformation,[mbOK], 0);
lblScore.Caption := IntToStr(0);
Schlange.Init;
RenderingTimer.Enabled := True;
Pause := True;
end;
// Pruefe ob die Position des Kopfes der Schlange die gleiche ist wie die des
// Haeppchen
if (Schlange.Teile[0].X = Haeppchen.X)
and (Schlange.Teile[0].Y = Haeppchen.Y)
then
begin
// ...dann wachse
Schlange.Wachse;
// .. und erzeuge ein neues Haeppchen
SetzeHaeppchen();
end;
end;
procedure TFmMain.SetzeHaeppchen;
var
Spielfeld:
array[0..52, 0..39]
of integer;
X, Y: integer;
Index: integer;
FreieFelder:
array[0..52*39-1]
of TPoint;
AnzahlFelder: integer;
begin
for Y := 0
to 39
do
begin
for X := 0
to 52
do
begin
Spielfeld[X, Y] := 0;
end;
end;
for Index := 0
to Schlange.AnzahlTeile
do
begin
Spielfeld[Schlange.Teile[
Index].X, Schlange.Teile[
Index].Y] := 1;
end;
AnzahlFelder := 0;
for Y := 0
to 39
do
begin
for X := 0
to 52
do
begin
if Spielfeld[X, Y] = 0
then
begin
FreieFelder[AnzahlFelder] := Point(X, Y);
AnzahlFelder := AnzahlFelder + 1;
end;
end;
end;
Index := Random(AnzahlFelder + 1);
Haeppchen.X := FreieFelder[
Index].X;
Haeppchen.Y := FreieFelder[
Index].Y;
end;
end.