belka/book-exercises
1
0
Fork 0
Code Activity

Закончил удава из 7-й главы, пятого упражнения

Browse Source
This commit is contained in:
Eugen Wissner
2026-04-04 20:25:37 +02:00
parent 3dff805e9b
commit e4dd7b7416
7 changed files with 597 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
Занимательное программирование/7/5_snake/Snake.lpi Normal file
View File

@@ -0,0 +1,77 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="Snake"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="Snake.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="Unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

15
Занимательное программирование/7/5_snake/Snake.lpr Normal file
View File

@@ -0,0 +1,15 @@
program Snake;
{$MODE Delphi}
uses
Forms, Interfaces,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

155
Занимательное программирование/7/5_snake/Snake.lps Normal file
View File

@@ -0,0 +1,155 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units>
<Unit>
<Filename Value="Snake.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="Unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="106"/>
<CursorPos X="51" Y="123"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
</Units>
<JumpHistory HistoryIndex="29">
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="82" Column="19" TopLine="34"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="177" Column="91" TopLine="136"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="121" Column="20" TopLine="81"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="214" Column="88" TopLine="163"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="41" Column="13" TopLine="12"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="54" Column="13" TopLine="12"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="62" Column="43" TopLine="12"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="69" Column="13" TopLine="18"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="80" Column="45" TopLine="31"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="64" Column="26" TopLine="49"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="60" Column="36" TopLine="34"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="65" Column="33" TopLine="34"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="69" Column="69" TopLine="40"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="233" TopLine="182"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="234" TopLine="182"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="58" Column="46" TopLine="22"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="59" Column="39" TopLine="31"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="75" Column="7" TopLine="31"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="104" Column="38" TopLine="74"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="17" Column="13"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="41" Column="19"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="63" Column="12" TopLine="28"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="60" Column="6" TopLine="31"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="42" Column="31" TopLine="4"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="72" Column="40" TopLine="37"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="89" Column="8" TopLine="57"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="91" Column="12" TopLine="61"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="123" Column="52" TopLine="92"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="235" Column="85" TopLine="201"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="10" Column="14"/>
</Position>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

75
Занимательное программирование/7/5_snake/Unit1.lfm Normal file
View File

@@ -0,0 +1,75 @@
object Form1: TForm1
Left = 526
Height = 1083
Top = 193
Width = 1280
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Snake'
ClientHeight = 1083
ClientWidth = 1280
Color = clBtnFace
DesignTimePPI = 144
Font.Color = clWindowText
Font.Height = -17
Font.Name = 'MS Sans Serif'
LCLVersion = '4.6.0.0'
OnActivate = FormActivate
OnKeyDown = FormKeyDown
object Screen: TImage
Left = 0
Height = 960
Top = 0
Width = 1280
end
object Label1: TLabel
Left = 480
Height = 28
Top = 1008
Width = 147
Caption = 'Длина удава:'
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'MS Sans Serif'
ParentFont = False
end
object SnakeLenLabel: TLabel
Left = 656
Height = 28
Top = 1008
Width = 13
Caption = '3'
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'MS Sans Serif'
ParentFont = False
end
object ImageList: TImageList
Height = 32
Width = 32
Bitmap = {
4C7A1200000020000000200000008D0200000000000078DAEDDC5D92DA400C45
612F9DA5B1B34EA8545EA642C08D6D89BEDF4C9D276638C2B87FA416DCEFF7ED
0EE0BFFCFE19FF22C5FF2C1E7E7E7E7E7EFE15FDCFD6DDABD6E36A3F000089DC
6EDB986115FF6CBCFCFC2BF8D3C7BFFB899FDFFA0F0040D6B9FF6DCCB08A7F36
5E7EFE15FCC6BFFB8FDFF837FE010048CAFFC77870D6DFF3F3F3F7F7EF6515FF
D9EF173F3FFF3A7E000096C8FF6FDB9861357FF5F5E7E737FEAFF7BB5FF893FD
C63F0000819FFFDFB631C36AFEEAEBCFCF6FFCF71FFFFCFC2BFA53C73F000091
E7FFFA7FA7E24DF37BDD5EB7D7CDCFCFBFB21F008088FC5FFFFFAEE7E3E75FC9
BF771C56CF436779DD7FFCC97EFDFF0000249DFF677FFFEFDEE7E3E75FD1EFFB
BF6BAE3F3F7FA5DFF807002430B631CE809F9F9F9F9F9F9F9F9FBFA31F0072F3
FF3F1F307BF5F84F669FAF9BFFD9FFBDFBC1FB4FBD5DFC7BBDEFBE1FDFE29FF5
1E154795FF28EF6C1CFCFCFCFCFCFC157E0048CFFF8F9A5FAF9AFFABFD47E5DF
DFEEFFD6BCF7ACFD47BADFFE933FD99F3AFE53E7FFD4F57F95FD1F00C8FFEDFF
F8F9F9F9F9F3CEFFD2F360FD5F99FD7FFA3F0140EFFFD56B71B5FFD3B57715BF
1EF8CC3340B927BFDC5F0F80F93F73FDB7FF0300BCE2F1452D8FDF44FF5F7755
0C95FE9FEEAB63A8F43F735F1543A5FF95FBEC182AFDEFBACF8AA1D2BFD77D74
0C95FE59F7513154FA3F757F1A43A5FF28F76C0C95FEA3DD7B63A8F60380FCBE
477EDF25C7EE92E776C935BBE47B5D72AE2E794F97DCA3CBFEBFCB1EFCDBF6C1
AB5CFFB4F19736FFA6ADBF69FB2F7B710040873A44623D3CF93CC47998F350E7
E1FA21F4C3E887D20FA71F523F2C00A0F3BC9CB61F49DB87A7E59F6975177D07
6A8E5DEA7E5D6A6F5DEA5F5D6A505DEA405D6A315DEA215D6A12EA0278C52F04
2A6937
}
end
end

275
Занимательное программирование/7/5_snake/Unit1.pas Normal file
View File

@@ -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.

BIN
Занимательное программирование/7/5_snake/pics.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 54 KiB

BIN
Занимательное программирование/7/5_snake/pics.xcf Normal file
View File

Binary file not shown.