1
0

Мигрирован sokoban проект с дельфи в lazarus

This commit is contained in:
2026-03-19 18:45:31 +01:00
parent 4438e2e921
commit cdc4d52b08
11 changed files with 743 additions and 0 deletions

View File

@@ -0,0 +1,12 @@
xxxxxxxxxxxxxxxxxxxx
x x
x x
x a x x
x x x
x s x x
x x x
x 1 xx xxxx
x ax x
x x 1 x
x x x
xxxxxxxxxxxxxxxxxxxx

View File

@@ -0,0 +1,12 @@
xxxxxxxxxxxxxxxxxxxx
x 1 1x
x x
x a x
x a x
x a s x
x a x
x 1 x
x a x
x 1 x
x1 x
xxxxxxxxxxxxxxxxxxxx

View File

@@ -0,0 +1,12 @@
xxxxxxxxxxxxxxxxxxxx
x1x x
x1x 1 x x
x x a x x
x x x
x x s a x x
x x x x
x x x x
x x a x x
x a x x
x x1x
xxxxxxxxxxxxxxxxxxxx

View File

@@ -0,0 +1,77 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="Sokoban"/>
<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="Sokoban.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>

View File

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

View File

@@ -0,0 +1,180 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units>
<Unit>
<Filename Value="Sokoban.lpr"/>
<IsPartOfProject Value="True"/>
<CursorPos X="20" Y="3"/>
<UsageCount Value="29"/>
<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="57"/>
<CursorPos X="39" Y="33"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="1.slv"/>
<EditorIndex Value="2"/>
<CursorPos X="21" Y="12"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="3.slv"/>
<EditorIndex Value="3"/>
<CursorPos X="20" Y="11"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="2.slv"/>
<EditorIndex Value="4"/>
<CursorPos X="5" Y="4"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
</Units>
<JumpHistory HistoryIndex="29">
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="33" Column="65" TopLine="16"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="135" Column="38" TopLine="85"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="33" Column="65" TopLine="4"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="130" Column="18" TopLine="101"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="131" Column="26" TopLine="85"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="141" Column="17" TopLine="104"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="128" Column="54" TopLine="87"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="132" Column="54" TopLine="91"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="131" Column="54" TopLine="90"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="36" Column="60" TopLine="18"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="41" Column="15" TopLine="12"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="40" Column="43"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="81" Column="24" TopLine="57"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="86" Column="34" TopLine="57"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="130" Column="59" TopLine="101"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="86" Column="50" TopLine="45"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="87" Column="16" TopLine="58"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="147" Column="42" TopLine="119"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="132" Column="40" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="149" Column="40" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="155" Column="36" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="162" Column="69" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="136" Column="44" TopLine="115"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="246" Column="18" TopLine="215"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="254" Column="59" TopLine="215"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="200" Column="20" TopLine="171"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="246" Column="18" TopLine="195"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="254" Column="59" TopLine="203"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="204" Column="8" TopLine="171"/>
</Position>
<Position>
<Filename Value="1.slv"/>
<Caret Line="4" Column="5"/>
</Position>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@@ -0,0 +1,160 @@
object Form1: TForm1
Left = 774
Height = 576
Top = 526
Width = 960
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Сокобан'
ClientHeight = 576
ClientWidth = 960
Color = clBtnFace
DesignTimePPI = 144
Font.Color = clWindowText
Font.Height = -17
Font.Name = 'MS Sans Serif'
Menu = MainMenu
LCLVersion = '4.6.0.0'
OnKeyDown = FormKeyDown
OnShow = FormShow
object Screen: TImage
Left = 0
Height = 576
Top = 0
Width = 960
Align = alClient
end
object BackBuffer: TImage
Left = 36
Height = 576
Top = 36
Width = 960
Visible = False
end
object MainMenu: TMainMenu
object FileMenu: TMenuItem
Caption = 'Файл'
object ItemOpen: TMenuItem
Caption = 'Открыть'
OnClick = ItemOpenClick
end
object ItemExit: TMenuItem
Caption = 'Выход'
OnClick = ItemExitClick
end
end
end
object ImageList: TImageList
Height = 32
Width = 32
Left = 84
Top = 12
Bitmap = {
4C7A120000002000000020000000540C00000000000078DAED5D79AC5F4515FE
416929A4C866444005A906D08A2D90B049A1205048150B84C568341291402085
420394D85B903F301521981051D0A4568D60D8A4A041FBA0153454446CA0C822
2D7BA12C852A7D409F33E59B3A6FDECCDC997BE7CCDCBE774E72D2BE3BF7CE37
EB99F3CDF6EBF57A033D5656565656565656565656565656565656D64E69E5D0
5C98030EA54A8B0FD397161A6C97A44F431584EB4F4745861D12D63C0D95337E
579DBBDF4B875FD7EED2E037C34E978630FCBAE729F1C3EBDAF5DDA68D5FBAFC
F3B6BFD2FDAF5BF6A78CFD2D3DFE7461FCED82FFD105FFAB0BFE272B2BABD2BE
BEBE8DFFBA940253A914571A94A44A832F7E5DABAADAA0B6F2C981AFDE9769B0
954D2C9ECA8BAF9E6DE9309FC5D6852D5F322D66BE7571A52DA60C54FDE97977
95A5994F332D66FB34D3E8CBB39E8E90E7BEB2E8C161A9EB1766FCB67FCDB49A
79B5958BAFEDD8B0F57277E53554F57663E299FD45D7D0F6EC6A0375EFE9F6A1
0BF8663D9975DF545DEDC365AF4CFC2678B63CDBDABFB20D66BE75FB9DA20C42
EBBF6E2C75955FE83BA6D8FA83D9FE7CEDC0AC37D778A4F73F5FFBD3ED8BAD4D
C4968B2F7D2EFC3AFB178A5F67A36D6340697C57FBD7E333DF6DDB27EAC65F13
A78D5D32FD8750BF23B44FFBD2646B8F757EB5996F57FBB0A531A49C42FC30D7
F7B6B4B5A9F73A7EA1DB485FFBAB6B3FB17EB82D3ED3378E298B26BE7F2AFC36
FCC3E59398BE2135FFF3D5873E9EB332FF67FEDF9EFFDB7CC40F9ED9E75F53D8
7DB71D899B7F6ECBFF87E6377EFEDDD747EAF2ECC38E5D7F08E917B6F123D5FA
4B13FE9F7AFD2996FFA75E7FF3F19F18FCA6EB8F75FC6B70B9D0ACBF86F27FAA
F5E770FE4FB3FE1ECAFFA9F043F93F55F987F37FDAF617C2FF29FA5F0CFFA7B0
3F31FC9FC2FEC6F07F8AF12796FF9B7DA1C9F8DB84FFDB7D9F78FFA32917B5CD
4134F1BF52F002B73F365429F8BF692BCC30E6FFCCFF878DCA32CCA19B68F9D8
D64243C2183FBC6F0FE581F6BEAF87FBC242E20E52F94D8C26CEFF863843FB57
C2FC6F7C3FB28FC7E2D4AD6FC6E2D7ADE1740DBFAE5CDAE0B7297F67FD9BBE9F
A7FEDB94BF756C72F99F8E3126297E1D076E881F3C363B38910FBF4DFD0FC2EF
F9F9D0A0345094BF877F94C61FD20E29EABF213E75FDA7C87F1A7C8427C41F62
FFBC69A81ADBBF60FBEFE4E1D520FC54F6DF3AFEB8F6DFE71C7F3DD829C7DF8D
F518E97F35F5B3BAE6FF35F28109FCFF14F30614710F17DD24CABF64FB2BCDBF
88ED4FBCFDF5FBFFA4F63FC0FF27E35F81FE3F19FF0AF4FF49F8D730F6FFD9FF
1ED9FE7F1CFFAEF7FF49EA3FC2FF279BFF08F4FFC9F857A0FF4FC6BF32CFBF8D
F4F9CF5CF3CF9DE75F85D71F8AAFBFF0FA5B717C5E7F66CD391F61DF1BD9F39E
D1F2FD6D8BF7FFBE25E3337E41BB17B1FF2AD4C6077FD741FC4AF76552D97D97
6F04FC213E4A2876C87AB4C73FEC59CEA96C68AF75F8A17B4103F1A3F2EFE1E1
D6FDB001F8D6FA7762D7E33BD31080EFF5F923F6E35AD7E693E037D8139CBCFC
63D25011B4BF0825E97F0DB053E53F763EA669FFCB687F79FCEB8EFFC1FEE708
C22FCDBF5899EB8FB4B6AEF579C62F8BDF25CE4FEE6B74199FC8DF0CAA7F2FD7
88E4F78EBD3883D63E42F09BF27B03DFBAF65687DF86DFB7CD7F5B7E6FC18FAA
FFB6FCDEC7B582F15BF0FB64F80DF97DDBF26FCBEF93F5BF96D86DFA5F1B7EDF
24FFA5ED2F8F7FC5FC0FF63F199FB97E19ED8234BDBFD576B76FCCFDCC21DFEB
E3A71A4F6CDF57C67B4DD26FC6DF34FF1BEFF0F1DCC3DB35FC21F7A404A423B6
FEBBFABD6D7F5AA8A6F8BE6B7DDFD5C7A8EAC8D7D6CC366ABD0FA8E5F7BEFE67
BDBFDC75C78EF6BDAB8F877E9F13BFCA54FE5DB411B9FA7857FB7FD7ED77AFAA
92F90FB1E37FDD18D874FC0E1DFF73E257015894B69DC7FF6EF6FD2E8FFFA69F
6BCB93EBFB9E631C0B1D7F2BCFF775362AC5F89F12BF6D1F4DE57F8DC4F1BFC7
C2C2B2C989E8D2E7097D1743CE5E1971B7117A93318CEF9509FBB342970B7D0F
F97F2733FE2D425F117A04FECE8D3F47E86EDADFEFE4AE7F233D8CCFF88CCFF8
C31E5F608C17BAD4D0F5C05F663C1F4F803F2182564F600F8985858585856558
F1FE8942E70B7D5668BFD03785FE157C783431F6D7B53987D7843E20F409CDEF
582C742CA1FFA5FCBDEF0BDD520B3B42E85A845D48847F05E2BFDF11FE3D842F
21C29F8C3A3ECA117E22F09F2AD42ECFA0CC7F0DF66642FF0CFCF30AE0CF02F6
E354EDDF837D2178C86AA17B67C41D25F43AE4FB45A1FB64C4FE90D0BB35EEB5
5B46EC6D853E04ECDFCBB464C4DE5A6BE70BA8EDBD057F01B0E53CE8A8CCD853
81BD52E8B8027DFC0FC05F65990730F56304F84B23F8FFA7D853626161616161
1956FCFF30A1BF85CFFD2EF8FF5F84CEA4E61E22FED99A8FF1027CD127B5677F
93FB0388B00F01CF795FE8E992F319DC780DD2309708FFE788FF278EF0B9087F
80087F8AD0EFB8D676C4F36F51E207A4EFD7C0BF3A23A6DC8B3249E88DC0FE97
D01D33E0EE6EF8DBB20F5C928B97089C5DC07B9F810D90FDE2EF424F2E50EFA3
857E43E8CB288B8B0BDA4529FF15BA5DA134BC8E344C21986B91F38B3708FDA4
E71D353F7A3841DE949D9FED083F54EB0F1F25C03F1F71CB3C9E6AD8FF89E8FB
52EE22AADB51187795BC8C79F7A7B57D004F53707F231D270B5D087CD9F7DFC2
B8FBDD9C73512C2C2C2C2C2C2C45E7032683134B392933F638F83C0385F0AF07
EEF3B9F105D671C0BC5DE8CD39F105CE0E987F916BBE3B17C0575CFF14FC9D0D
5F6202EB57DAB32CF828EBD5686FDB17C0BF1338538DE7E4F822EE6F03E33A4B
1829BEE4BCE0398FCA35F002F833238F35FF2231FE979047973EA7E6FEF0F7B9
99EDF0CD25EC3FE377039F858585858585856C8C1F1BE87B7E9390FB0C60CDC1
B7F7711A11FEDEC07FA650F91F04FC870BE11FABAE172A847F1AF06F2D847F16
F0E5DCC345B21E84FE07E73EE4FF2F16BA1521FE25463F93EB8D8BB006AF44EE
0BDF9608FF52A12F619DFF2023EC286DFD7D7EA1FA3901F8722EF2C305F04761
ED5FCAD185CAE059E04F27887B73ECFB18ED08DF529B073E98007F25E23EDD11
AECEFFACD1CF6625C457E7AF5E37F75760EFC76A845F4638FEF6697D5D9E7BFB
93D0C7B46792876F41DCC6E5DE877B501FF2FCDFAB388732684F040B0B0B0B0B
0BCBB09B0B982EF48F38832FD7C51E01271A97017B1E7C9DF5D87778BFE6772F
26E6606AED57AE774DD49EEF82B541293389B037D3F6C04EB1841F867DE8A711
E11F5078FE419D71FF41217C75FE429E81F88C5CFF071F5E27EF3C40BBDC8110
5F9D379F8739871538072DE700DED638C14788F0176BFCFA4A9D67E03CC23273
5F4462FC7B11FF3F2517B5844F46F87B14732022CE3B10FF8F3DFD53D9A14308
F0AF41DC3FF5BCB3826AFE41C4F935DFFD1AE086FD78671201FEF6DAF9824996
F0AF20EC2DAA7B09B4B147CEF7EDAA3D1FAFED439B476803C6A2BFAB73268B70
064E95FB12CAF10F69D802F7C03C04BBB316FFBF8062DE85858585858585A528
E75F52F2FE1FE9F706DC7BA4D69F3E51A07C4EA1E43F01BEB1E4A26F509C7D0D
C057F7B0CD2880FD3970BEE5946B5F1EFCBB90F7E30B601F08ECA5856CC2EDC0
FF6A01ECDDD1DF5F29C13BE44F1A21EFD7162A7B35DF724C01EC5D81BDAE50D9
2B5BFB8F42657F39F07F59087F3EF0AF29DCEF2F67CF8885858585856544CC03
1C29F7601BF7FFC9739F33848E21C69EABADFD2FC27D54B7200D521EA4BA8348
C4BBBF76FEE070236C47DCBD2EE54A22FC3988FF6E47F8D9087F8498EF2C7084
ABFDF9CB88F08F56BF2F606B67E2D90F117E7D06BF57B6B97DB01E27F77E9C8B
35B81729E79E70D7DD2CCCF3987203F5BC177EE7E209F4BFFBB0DFE40EEC8996
EB805751DDCB8E3BD6FA81F3054BFFEBA3BCFF51BB7BAD72847F1AE1FD147740
6AE73C8EF1BCA3ECE0A104F8AB10F7973DEFA876F945027CB5FFE48A9AF297F2
71027C75BFE95AF37C037E936121C2EF216A7F727FC9CFB4F14FF5BF5B310736
8036426D03E4DEBFDF69F7FFADC1FAFF1CAAB3472C2C2C2C2C2C2CC5F9BF5C73
FC0DEE7FEB871F7093D07D33609FA9ADF1AFC4F9C7151A2F9F4E883D41FBEDC1
19C6FDCFE76B7B4F7722C2FF510DFF5F487CFEF441B5FFDD113E8D724D4EFB9D
C7698EF03DB5763086007F694DFEF7D0F8C71E04F86A8FC59D8EF07334FCCF13
E0EFA7DD337E86113615DC731DC2F7239E031BC0799BDB701E60006BB2EA0CF6
9E8476E024EC857A1B79BE17770F8CC13E948112F7FF633E6AC3EFA2141A1766
F9E60713C47F30F680CDB6846D25F4DFC03F8EB07CD7A38D1FAB3DDF1AE3A194
FB88CBF82AADFD3FAC9DC153BF01B273867A3E156D7E15CE202CC7DD08DBF458
58585822E47F110951EA
}
end
object OpenDialog: TOpenDialog
Filter = 'Уровни Сокобана (*.slv)|*.slv'
Left = 144
Top = 12
end
end

View File

@@ -0,0 +1,271 @@
unit Unit1;
{$MODE objfpc}{$H+}
interface
uses
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, ImgList;
type
TForm1 = class(TForm)
MainMenu: TMainMenu;
FileMenu: TMenuItem;
ItemOpen: TMenuItem;
ItemExit: TMenuItem;
Screen: TImage;
ImageList: TImageList;
OpenDialog: TOpenDialog;
BackBuffer: TImage;
procedure ItemExitClick(Sender: TObject);
procedure ItemOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
const
WALL = 11; SPACE = 10; BOULDER = 1;
SL = 14; SR = 15; SU = 12; SD = 13; { Индексы спрайтов. }
BOULDER_SET = ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i'];
PLACE_SET = ['1', '2', '3', '4', '5', '6', '7', '8', '9'];
var
Form1: TForm1;
Field: array[1..20, 1..12] of Integer; { Игровое поле. }
Places: array[1..20, 1..12] of Integer; { Положение мест. }
PlaceCount: Integer; { Общее число мест на уровне. }
CurX, CurY: Integer; { Текущее положение Сокобана. }
Positioned: Integer; { Количество размещенных камней. }
Busy: Boolean = false; { Статус обработчика клавиш. }
implementation
{$R *.lfm}
{ Перевод символа в порядковый номер картинки. }
function SymbolToCode(c: Char): Integer;
begin
case c of
'x': SymbolToCode := WALL; { 'x' - стена }
' ': SymbolToCode := SPACE; { ' ' - пустое пространство }
's': SymbolToCode := SL; { 's' - стартовая локация }
else
SymbolToCode := -1 { Неизвестный символ. }
end;
end;
{ Загрузить уровень из файла. }
procedure LoadLevel(FileName: String);
var f: File of Char;
i, j : Integer;
c: Char;
begin
AssignFile(f, FileName); { Открыть файл. }
Reset(f);
PlaceCount := 0; { Подсчет количества мест. }
for j := 1 to 12 do { Цикл по строкам. }
begin
for i := 1 to 20 do { Цикл по элементам строки. }
begin
Read(f, c); { Считаем текущий эелемент }
if c in PLACE_SET then { если это "место" }
begin
Field[i, j] := SPACE; { в поле равнозначно пустому элементу }
VAL(c, Places[i, j]); { True в массиве Places }
Inc(PlaceCount)
end
else if c in BOULDER_SET then
begin
Places[i, j] := 0;
Field[i, j] := ORD(c) - ORD('`')
end
else
begin
Places[i, j] := 0; { иначе НЕ "место" }
Field[i, j] := SymbolToCode(c); { определяем код элемента }
if c = 's' then { если текущая локация - }
begin { стартовая, запоминаем }
CurX := i; { ее координаты }
CurY := j
end
end
end;
Read(f, c); { считываем и пропускаем возврат каретки }
Read(f, c) { считываем и пропускаем перевод строки }
end;
CloseFile(f) { закрыть файл }
end;
{ Перерисовка уровня. }
procedure RedrawField;
var
i, j: Integer;
code: Integer;
bitmap: TBitmap;
ScreenRect: TRect;
begin
bitmap := TBitmap.Create; { объект для временного хранения рисунка }
Positioned := 0; { считаем, что размещено 0 камней }
for j := 1 to 12 do
for i := 1 to 20 do
begin
code := Field[i, j]; { код текущего элемента }
{ Пара "пустое пространство" / "место" означает "место" }
if Field[i, j] = WALL then
code := 8
else if Field[i, j] = SU then
code := 4
else if Field[i, j] = SD then
code := 5
else if Field[i, j] = SL then
code := 6
else if Field[i, j] = SR then
code := 7
else if (Field[i, j] = SPACE) and (Places[i, j] <> 0) then
begin
Form1.ImageList.GetBitmap(0, bitmap);
Form1.BackBuffer.Canvas.Draw((i - 1) * 32, (j - 1) * 32, bitmap);
code := 8 + Places[i, j]
end
else if Field[i, j] = SPACE then
code := 0
{ а пара "камень" / "место" - "камень на месте" }
else if Field[i, j] = Places[i, j] then
begin
code := 3;
{ При этом увеличиваем счетчик размещенных камней. }
Inc(Positioned)
end
else if Field[i, j] > 0 then
begin
Form1.ImageList.GetBitmap(2, bitmap);
Form1.BackBuffer.Canvas.Draw((i - 1) * 32, (j - 1) * 32, bitmap);
code := 8 + Field[i, j]
end;
Form1.ImageList.GetBitmap(code, bitmap); { Достаем картинку }
{ и рисуем ее на соответствующем месте виртуального экрана. }
Form1.BackBuffer.Canvas.Draw((i - 1) * 32, (j - 1) * 32, bitmap)
end;
bitmap.Free;
{ Копируем содержимое виртуального экрана на основной. }
ScreenRect := Rect(0, 0, 640, 384);
Form1.Screen.Canvas.CopyRect(ScreenRect, Form1.BackBuffer.Canvas, ScreenRect)
end;
{--------------------------------------------------------------------------}
procedure TForm1.ItemExitClick(Sender: TObject);
begin
Application.Terminate
end;
{--------------------------------------------------------------------------}
procedure TForm1.ItemOpenClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
LoadLevel(OpenDialog.FileName);
RedrawField
end;
end;
{--------------------------------------------------------------------------}
procedure TForm1.FormShow(Sender: TObject);
begin
while not OpenDialog.Execute do
;
LoadLevel(OpenDialog.FileName);
RedrawField
end;
{--------------------------------------------------------------------------}
function PositionBy(x, y: Integer; scale: Integer = 1): Integer;
begin
Result := Field[CurX + x * scale, CurY + y * scale]
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
dx, dy: Integer; { Смещения Сокобана (куда идем). }
SprIdx: Integer; { Текущий номер его спрайта. }
begin
if Busy then Exit; { Если обработчик занят, выходим. }
Busy := true; { статус = занято }
case Key of
VK_LEFT:
begin { идем влево }
dx := -1;
dy := 0;
SprIdx := SL
end;
VK_RIGHT:
begin { вправо }
dx := 1;
dy := 0;
SprIdx := SR
end;
VK_UP:
begin { вверх }
dx := 0;
dy := -1;
SprIdx := SU
end;
VK_DOWN:
begin { вниз }
dx := 0;
dy := 1;
SprIdx := SD
end;
else
{ никуда не идем }
dx := 0;
dy := 0;
SprIdx := Field[CurX, CurY]
end;
if PositionBy(dx, dy) = SPACE then { если целевая клетка пуста }
begin
Field[CurX + dx, CurY + dy] := SprIdx; { переходим в нее }
Field[CurX, CurY] := SPACE; { на старой позиции теперь ничего нет }
CurX := CurX + dx;
CurY := CurY + dy;
end
{ если целевая клетка содержит камень, а клетка, следующая за ней, пуста }
else if (PositionBy(dx, dy) = BOULDER) and (PositionBy(dx, dy, 2) = SPACE) then
begin { двигаем камень: }
Field[CurX + dx, CurY + dy] := SprIdx; { новая позиция Сокобана }
Field[CurX + 2 * dx, CurY + 2 * dy] := BOULDER; { новая позиция камня }
Field[CurX, CurY] := SPACE; { на старой позиции - пусто }
CurX := CurX + dx;
CurY := CurY + dy;
end;
RedrawField; { перерисовываем уровень }
{ Если все камни размещены }
if Positioned = PlaceCount then
Application.MessageBox('Уровень пройден!', 'Sokoban', MB_ICONEXCLAMATION);
Application.ProcessMessages;
Busy := false; { статус = свободно }
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.7 KiB

View File

@@ -18,3 +18,7 @@ Lazarus.
Шестая глава "Алгоритмы на графах" отсутствует, поскольку содержит Шестая глава "Алгоритмы на графах" отсутствует, поскольку содержит
только теоретические задания. только теоретические задания.
Седьмая глава "Простые компьютерные игры" применяет Lazarus. Изображения
для частично сделаны заново, частично скопированы из приложения книги
и отредактированы.