unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, LCLType, ExtCtrls;
type
TItem = (Emtpy, Snake, Fruit);
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
private
procedure ClearWorld;
procedure PutItem(X, Y: Integer; Item: TItem);
function GetItem(X, Y: Integer): TItem;
procedure DrawGameWorld;
Procedure Movesnake(NewHead: TRect);
end;
var
Form1: TForm1;
snakepos:trect;
direction:integer;
SnakeBody: TList;
SnakeIsGrowing: Boolean = False;
implementation
uses
types;
const
WorldWidth = 25;
WorldHeight = 25;
Scale = 20;
var
GameWorld: array[1..WorldWidth, 1..WorldHeight] of TItem;
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
SnakeSegment: PRect;
begin
SnakeBody := TList.Create;
PutItem(snakepos.left, snakepos.top, snake);
snakepos.left:=random(10);
snakepos.top:=random(10);
SnakeSegment^ := snakepos;
SnakeBody.Add(SnakeSegment);
drawgameworld;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SnakeBody.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
PutItem(snakepos.left, snakepos.top, snake);
Drawgameworld;
if key=vk_left then
begin
direction:=1;
end;
if key=vk_right then
begin
direction:=2;
end;
if key=vk_up then
begin
direction:=3;
end;
if key=vk_down then
begin
direction:=4;
end;
if key=VK_ADD then
begin
SnakeIsGrowing := True;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
MoveSnake(snakepos);
if direction = 1 then
begin
snakepos.left:=snakepos.left-1;
end;
if direction = 2 then
begin
snakepos.left:=snakepos.left+1;
end;
if direction = 3 then
begin
snakepos.top:=snakepos.top-1;
end;
if direction = 4 then
begin
snakepos.top:=snakepos.top+1;
end;
end;
procedure TForm1.ClearWorld;
var
X, Y: Integer;
begin
for X := 1 to WorldWidth do
for Y := 1 to WorldHeight do
GameWorld[X, Y] := Emtpy;
end;
procedure TForm1.PutItem(X, Y: Integer; Item: TItem);
begin
if (X < 1) or (X > WorldWidth) then Exit;
if (Y < 1) or (Y > WorldHeight) then Exit;
GameWorld[X, Y] := Item;
end;
function TForm1.GetItem(X, Y: Integer): TItem;
begin
Result := Emtpy;
if (X < 1) or (X > WorldWidth) then Exit;
if (Y < 1) or (Y > WorldHeight) then Exit;
Result := GameWorld[X, Y];
end;
procedure TForm1.DrawGameWorld;
const
Padding = 2;
var
X, Y: Integer;
ScreenX, ScreenY: Integer;
begin
Refresh;
for X := 1 to WorldWidth do
for Y := 1 to WorldHeight do
begin
ScreenX := X * Scale;
ScreenY := Y * Scale;
case GameWorld[X, Y] of
Emtpy: ; // do nothing
Snake: begin
Canvas.Pen.Color := clBlue;
Canvas.Brush.Color := clwhite;
Canvas.Rectangle(ScreenX, ScreenY, ScreenX+Scale-Padding, ScreenY+Scale-Padding);
end;
Fruit: begin
Canvas.Pen.Color := clBlack;
Canvas.Brush.Color := clRed;
Canvas.Ellipse(ScreenX, ScreenY, ScreenX+Scale-Padding, ScreenY+Scale-Padding);
end;
end;
end;
end;
procedure TForm1.MoveSnake(NewHead: TRect);
var
SnakeSegment: PRect;
begin
New(SnakeSegment);
SnakeSegment^ := NewHead;
SnakeBody.Insert(0, SnakeSegment);
if not(SnakeIsGrowing) then begin
SnakeSegment := SnakeBody[SnakeBody.Count-1];
PutItem(SnakeSegment^.Left, SnakeSegment^.Top, Emtpy);
Freemem(SnakeSegment);
SnakeBody.Delete(SnakeBody.Count-1);
end;
SnakeIsGrowing := False;
end;
end.
Recent
