procedure TForm1.FormCreate(Sender: TObject);
var
SnakeSegment: PRect;
begin
SnakeBody := TList.Create;
snakepos.left:=random(24);
snakepos.top:=random(24);
foodpos.left:=random(24);
foodpos.top:=random(24);
New(SnakeSegment);
SnakeSegment^ := snakepos;
SnakeBody.Add(SnakeSegment);
drawgameworld;
edit1.clear;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SnakeBody.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if score >= 1 then
begin
case direction of
1,3,4: if key=vk_left then
begin
direction:=1;
end;
2: if key=vk_left then
begin
direction:=2;
end;
end;
case direction of
2,3,4: if key=vk_right then
begin
direction:=2;
end;
1: if key=vk_right then
begin
direction:=1;
end;
end;
case direction of
1,2,3: if key=vk_up then
begin
direction:=3;
end;
4: if key=vk_up then
begin
direction:=4;
end;
end;
case direction of
1,2,4: if key=vk_down then
begin
direction:=4;
end;
3: if key=vk_down then
begin
direction:=3;
end;
end;
end;
if score = 0 then
begin
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;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
begin
case direction of
1: begin
xdirection:=-1;
ydirection:=0;
end;
2: begin
xdirection:=1;
ydirection:=0;
end;
3: begin
xdirection:=0;
ydirection:=-1;
end;
4: begin
xdirection:=0;
ydirection:=1;
end;
end;
if (snakepos.left = foodpos.left) and (snakepos.top = foodpos.top) then
begin
foodpos.left:=random(22)+1;
foodpos.top:=random(22)+1;
PutItem(foodpos.left, foodpos.top, fruit);
snakeisgrowing:=true;
score:=score+1;
count.caption:=inttostr(score);
end;
if (snakepos.left > 23) or (snakepos.left < 1) or (snakepos.top > 23) or (snakepos.top < 1) then
begin
for i:= 3 to 5 do
begin
(FindComponent('l' + IntToStr(i)) as TLabel).visible:=true;
end;
timer1.enabled:=false;
edit1.Visible:=true;
button1.Visible:=true;
l4.caption:= count.caption;
count.visible:=false;
clearworld;
putitem(foodpos.left, foodpos.right, emtpy);
end;
snakepos.left:=snakepos.left+xdirection;
snakepos.top:=snakepos.top+ydirection;
MoveSnake(snakepos);
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 = 0;
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 := shape1.brush.color;
Canvas.Brush.Color := clwhite;
Canvas.Rectangle(ScreenX, ScreenY, ScreenX+Scale, ScreenY+Scale);
end;
Fruit: begin
Canvas.Pen.Color := shape1.brush.color;
Canvas.Brush.Color := clRed;
Canvas.rectangle(ScreenX+padding, ScreenY+padding, 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;
PutItem(snakepos.left, snakepos.top, snake);
PutItem(foodpos.left, foodpos.top, fruit);
if (snakeSegment^.left = snakepos.left) and snakesegment^.top = snakepos.top) then
begin
timer1.enabed:=true;
end;
Drawgameworld;
end;
end.