From e4dd7b74168344d41abe501a3c8f5b8438cca58a Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 4 Apr 2026 20:25:37 +0200 Subject: =?UTF-8?q?=D0=97=D0=B0=D0=BA=D0=BE=D0=BD=D1=87=D0=B8=D0=BB=20?= =?UTF-8?q?=D1=83=D0=B4=D0=B0=D0=B2=D0=B0=20=D0=B8=D0=B7=207-=D0=B9=20?= =?UTF-8?q?=D0=B3=D0=BB=D0=B0=D0=B2=D1=8B,=20=D0=BF=D1=8F=D1=82=D0=BE?= =?UTF-8?q?=D0=B3=D0=BE=20=D1=83=D0=BF=D1=80=D0=B0=D0=B6=D0=BD=D0=B5=D0=BD?= =?UTF-8?q?=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/5_snake/Unit1.pas" | 275 +++++++++++++++++++++ 1 file changed, 275 insertions(+) create mode 100644 "\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/5_snake/Unit1.pas" (limited to 'Занимательное программирование/7/5_snake/Unit1.pas') diff --git "a/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/5_snake/Unit1.pas" "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/5_snake/Unit1.pas" new file mode 100644 index 0000000..a26f200 --- /dev/null +++ "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/5_snake/Unit1.pas" @@ -0,0 +1,275 @@ +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. -- cgit v1.2.3