276 lines
8.6 KiB
ObjectPascal
276 lines
8.6 KiB
ObjectPascal
unit Unit1;
|
||
|
||
{$MODE objfpc}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls;
|
||
|
||
type
|
||
TForm1 = class(TForm)
|
||
Screen: TImage;
|
||
ImageList: TImageList;
|
||
Label1: TLabel;
|
||
SnakeLenLabel: TLabel;
|
||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||
procedure FormActivate(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
public
|
||
{ Public declarations }
|
||
end;
|
||
|
||
type Coords = record { Координаты клетки }
|
||
x, y: Integer
|
||
end;
|
||
|
||
const
|
||
{ Размеры поля }
|
||
FieldHeight = 30;
|
||
FieldWidth = 40;
|
||
{ Скорость игры }
|
||
MSecsPerFrame = 150;
|
||
CellSize = 32;
|
||
|
||
var
|
||
Form1: TForm1;
|
||
Snake: array[1..FieldHeight * FieldWidth] of Coords; { Удав }
|
||
SnakeLength: Integer; { Длина удава }
|
||
dx, dy: Integer; { Текущее направление }
|
||
Background, Body: TBitmap; { Элементы игрового поля }
|
||
Head, Tail: array[1..4] of TBitmap;
|
||
FirstRun: Boolean = true; { Индикатор первого запуска }
|
||
Number: Coords; { Положение текущей цифры }
|
||
CurNumber: Integer; { и ее значение }
|
||
|
||
implementation
|
||
|
||
{$R *.lfm}
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Загрузка картинок (элементов игры) }
|
||
procedure LoadBitmaps;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Background := TBitmap.Create;
|
||
Body := TBitmap.Create;
|
||
|
||
for i := 1 to 4 do
|
||
begin
|
||
Head[i] := TBitmap.Create;
|
||
Tail[i] := TBitmap.Create
|
||
end;
|
||
Form1.ImageList.GetBitmap(10, Head[1]);
|
||
Form1.ImageList.GetBitmap(11, Head[2]);
|
||
Form1.ImageList.GetBitmap(12, Head[3]);
|
||
Form1.ImageList.GetBitmap(13, Head[4]);
|
||
Form1.ImageList.GetBitmap(14, Tail[1]);
|
||
Form1.ImageList.GetBitmap(15, Tail[2]);
|
||
Form1.ImageList.GetBitmap(16, Tail[3]);
|
||
Form1.ImageList.GetBitmap(17, Tail[4]);
|
||
Form1.ImageList.GetBitmap(9, Body);
|
||
|
||
Background.SetSize(CellSize, CellSize);
|
||
Background.Canvas.Brush.Color := clLtGray;
|
||
Background.Canvas.FillRect(0, 0, CellSize, CellSize)
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Освобождение памяти }
|
||
procedure FreeBitmaps;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Background.Free;
|
||
Body.Free;
|
||
for i := 1 to 4 do
|
||
begin
|
||
Head[i].Free;
|
||
Tail[i].Free
|
||
end
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Очистка экрана }
|
||
procedure ClearField;
|
||
var i, j: Integer;
|
||
begin
|
||
for i := 0 to FieldWidth do
|
||
for j := 0 to FieldHeight do
|
||
Form1.Screen.Canvas.Draw(i * CellSize, j * CellSize, Background)
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Инициализация удава }
|
||
procedure InitSnake;
|
||
begin
|
||
SnakeLength := 3; { Изначально длина равна трем (голова, тело и хвост) }
|
||
{ Координаты сегментов }
|
||
Snake[1].x := 0;
|
||
Snake[2].x := 1;
|
||
Snake[3].x := 2;
|
||
Snake[1].y := 0;
|
||
Snake[2].y := 0;
|
||
Snake[3].y := 0;
|
||
{ Изначально удав ползет вправо }
|
||
dx := 1;
|
||
dy := 0;
|
||
{ Рисуем удава }
|
||
Form1.Screen.Canvas.Draw(0, 0, Tail[2]);
|
||
Form1.Screen.Canvas.Draw(CellSize, 0, Body);
|
||
Form1.Screen.Canvas.Draw(CellSize * 2, 0, Head[2])
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Определение статуса клетки (удав/свободно) }
|
||
function IsSnake(X, Y: Integer) : Boolean;
|
||
var i: Integer;
|
||
begin
|
||
IsSnake := false;
|
||
for i := 1 to SnakeLength do
|
||
if (Snake[i].x = X) and (Snake[i].y = Y) then
|
||
IsSnake := true
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Разместить случайную цифру (на игровом поле) }
|
||
procedure PlaceNumber;
|
||
var Temp: TBitmap;
|
||
begin
|
||
Temp := TBitmap.Create; { Временыый объект для хранения картинки }
|
||
repeat
|
||
Number.x := Random(FieldWidth); { Выбираем случайные координаты }
|
||
Number.y := Random(FieldHeight)
|
||
until not isSnake(Number.x, Number.y); { пока они не окажутся допустимыми }
|
||
|
||
CurNumber := 1 + Random(9); { Выбираем случайное значение цифры }
|
||
{ Рисуем цифру на экране }
|
||
Form1.ImageList.GetBitmap(CurNumber - 1, Temp);
|
||
Form1.Screen.Canvas.Draw(CellSize * Number.x, CellSize * Number.y, Temp);
|
||
Temp.Free
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Обработка клавиш }
|
||
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||
begin
|
||
case Key of
|
||
VK_LEFT:
|
||
begin
|
||
dx := -1;
|
||
dy := 0
|
||
end;
|
||
VK_RIGHT:
|
||
begin
|
||
dx := 1;
|
||
dy := 0
|
||
end;
|
||
VK_UP:
|
||
begin
|
||
dx := 0;
|
||
dy := -1
|
||
end;
|
||
VK_DOWN:
|
||
begin
|
||
dx := 0;
|
||
dy := 1
|
||
end
|
||
end
|
||
end;
|
||
|
||
function GetDirectionIndex(dx, dy: Integer): Integer;
|
||
begin
|
||
if (dx = -1) and (dy = 0) then
|
||
Result := 4
|
||
else if (dx = 1) and (dy = 0) then
|
||
Result := 2
|
||
else if (dx = 0) and (dy = -1) then
|
||
Result := 1
|
||
else if (dx = 0) and (dy = 1) then
|
||
Result := 3
|
||
else
|
||
Result := 0
|
||
end;
|
||
|
||
{-------------------------------------------------------------------}
|
||
{ Главная процедура }
|
||
procedure TForm1.FormActivate(Sender: TObject);
|
||
var
|
||
oldtime: TDateTime;
|
||
NewX, NewY: Integer; { Координаты целевой клетки }
|
||
ToGrow, DirectionIndex: Integer;
|
||
begin
|
||
if not FirstRun then
|
||
Exit; { Процедура работает лишь при первом запуске }
|
||
|
||
FirstRun := false;
|
||
Randomize;
|
||
LoadBitmaps; { Загрузка изображений }
|
||
|
||
while ID_CANCEL <> Application.MessageBox('OK - запуск, Cancel - выход', 'Snake', MB_OKCANCEL) do
|
||
begin
|
||
ClearField; { Очистка игрового поля }
|
||
InitSnake; { Создание удава }
|
||
PlaceNumber; { Генерация случайной цифры }
|
||
ToGrow := 0; { Количество сегментов, на которое должен вырасти удав }
|
||
{ Главный цикл }
|
||
while true do
|
||
begin
|
||
oldtime := Now;
|
||
{ Определение целевой клетки }
|
||
NewX := Snake[SnakeLength].x + dx;
|
||
NewY := Snake[SnakeLength].y + dy;
|
||
|
||
{ Если сделан недопустимый ход, конец игры }
|
||
if (NewX < 0) or (NewX >= FieldWidth) or (NewY < 0) or
|
||
(NewY >= FieldHeight) or IsSnake(NewX, NewY) then
|
||
Break; { Конец игры }
|
||
|
||
{ Если текущая клетка содержит цифру программируем рост удава }
|
||
if (NewX = Number.x) and (NewY = Number.y) then
|
||
begin
|
||
ToGrow := ToGrow + CurNumber;
|
||
{ Генерируем очередную цифру }
|
||
PlaceNumber
|
||
end;
|
||
|
||
if ToGrow > 0 then { Если удав растет }
|
||
begin
|
||
ToGrow := ToGrow - 1;
|
||
SnakeLength := SnakeLength + 1 { Увеличиваем его длину }
|
||
end;
|
||
{ Обновление координат удава }
|
||
Snake[SnakeLength + 1].x := NewX;
|
||
Snake[SnakeLength + 1].y := NewY;
|
||
|
||
DirectionIndex := GetDirectionIndex(dx, dy);
|
||
|
||
Form1.Screen.Canvas.Draw(CellSize * Snake[1].x, CellSize * Snake[1].y, Background);
|
||
Form1.Screen.Canvas.Draw(CellSize * Snake[2].x, CellSize * Snake[2].y,
|
||
Tail[DirectionIndex]);
|
||
|
||
{ Сдвиг массива }
|
||
Move(Snake[2], Snake[1], SizeOf(Coords) * SnakeLength);
|
||
|
||
Form1.Screen.Canvas.Draw(CellSize * Snake[SnakeLength - 1].x,
|
||
CellSize * Snake[SnakeLength - 1].y, Body);
|
||
Form1.Screen.Canvas.Draw(CellSize * Snake[SnakeLength].x,
|
||
CellSize * Snake[SnakeLength].y, Head[DirectionIndex]);
|
||
|
||
{ Вывод на экран текущей длины удава }
|
||
Form1.SnakeLenLabel.Caption := IntToStr(SnakeLength);
|
||
|
||
{ Задержка перед следующим циклом }
|
||
Application.ProcessMessages;
|
||
while Round(MSecsPerFrame - (Now - oldtime) * MSecsPerDay) > 0 do
|
||
Application.ProcessMessages
|
||
end
|
||
end;
|
||
FreeBitmaps; { Освобождение выделенной памяти }
|
||
Application.Terminate { Выход из программы }
|
||
end;
|
||
|
||
end.
|