From 8987b96aeb0937290320e6d9ed2e18ff706f3723 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 10 Apr 2026 09:56:05 +0200 Subject: [PATCH] =?UTF-8?q?=D0=97=D0=B0=D0=BA=D0=BE=D0=BD=D1=87=D0=B8?= =?UTF-8?q?=D0=BB=20=D1=82=D0=B5=D1=82=D1=80=D0=B8=D1=81=20=D0=B8=D0=B7=20?= =?UTF-8?q?7-=D0=B9=20=D0=B3=D0=BB=D0=B0=D0=B2=D1=8B,=20=D1=88=D0=B5=D1=81?= =?UTF-8?q?=D1=82=D0=BE=D0=B3=D0=BE=20=D1=83=D0=BF=D1=80=D0=B0=D0=B6=D0=BD?= =?UTF-8?q?=D0=B5=D0=BD=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/6_tetris/Tetris.lpi | 82 ++++ .../7/6_tetris/Tetris.lpr | 15 + .../7/6_tetris/Tetris.lps | 179 +++++++ .../7/6_tetris/Unit1.lfm | 89 ++++ .../7/6_tetris/Unit1.pas | 438 ++++++++++++++++++ .../7/6_tetris/pics.bmp | Bin 0 -> 1350 bytes .../7/6_tetris/unit2.pas | 78 ++++ 7 files changed, 881 insertions(+) create mode 100644 Занимательное программирование/7/6_tetris/Tetris.lpi create mode 100644 Занимательное программирование/7/6_tetris/Tetris.lpr create mode 100644 Занимательное программирование/7/6_tetris/Tetris.lps create mode 100644 Занимательное программирование/7/6_tetris/Unit1.lfm create mode 100644 Занимательное программирование/7/6_tetris/Unit1.pas create mode 100644 Занимательное программирование/7/6_tetris/pics.bmp create mode 100644 Занимательное программирование/7/6_tetris/unit2.pas diff --git a/Занимательное программирование/7/6_tetris/Tetris.lpi b/Занимательное программирование/7/6_tetris/Tetris.lpi new file mode 100644 index 0000000..4f7b8f8 --- /dev/null +++ b/Занимательное программирование/7/6_tetris/Tetris.lpi @@ -0,0 +1,82 @@ + + + + + + + + <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="Tetris.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="Unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + <Unit> + <Filename Value="unit2.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Unit2"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </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> diff --git a/Занимательное программирование/7/6_tetris/Tetris.lpr b/Занимательное программирование/7/6_tetris/Tetris.lpr new file mode 100644 index 0000000..31a2f97 --- /dev/null +++ b/Занимательное программирование/7/6_tetris/Tetris.lpr @@ -0,0 +1,15 @@ +program Tetris; + +{$MODE objfpc}{$H+} + +uses + Forms, Interfaces, + Unit1 in 'Unit1.pas', Unit2 {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run +end. diff --git a/Занимательное программирование/7/6_tetris/Tetris.lps b/Занимательное программирование/7/6_tetris/Tetris.lps new file mode 100644 index 0000000..d4a0d31 --- /dev/null +++ b/Занимательное программирование/7/6_tetris/Tetris.lps @@ -0,0 +1,179 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <Version Value="12"/> + <BuildModes Active="Default"/> + <Units> + <Unit> + <Filename Value="Tetris.lpr"/> + <IsPartOfProject Value="True"/> + <CursorPos X="16" Y="13"/> + <UsageCount Value="34"/> + <Loaded Value="True"/> + </Unit> + <Unit> + <Filename Value="Unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <EditorIndex Value="1"/> + <TopLine Value="337"/> + <CursorPos X="41" Y="343"/> + <UsageCount Value="34"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit> + <Unit> + <Filename Value="unit2.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Unit2"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="2"/> + <TopLine Value="16"/> + <CursorPos X="21" Y="30"/> + <UsageCount Value="28"/> + <Loaded Value="True"/> + </Unit> + <Unit> + <Filename Value="../../../../opt/lazarus/fpc/3.2.2/source/rtl/objpas/classes/classes.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="211"/> + <CursorPos X="22" Y="226"/> + <UsageCount Value="10"/> + </Unit> + <Unit> + <Filename Value="../../../../opt/lazarus/lcl/include/canvas.inc"/> + <EditorIndex Value="-1"/> + <CursorPos Y="25"/> + <UsageCount Value="13"/> + </Unit> + </Units> + <JumpHistory HistoryIndex="29"> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="302" Column="12" TopLine="278"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="151" Column="20" TopLine="132"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="92" Column="40" TopLine="64"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="95" Column="15" TopLine="83"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="379" Column="16" TopLine="362"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="381" Column="21" TopLine="362"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="379" Column="11" TopLine="362"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="87" Column="21" TopLine="73"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="170" Column="18" TopLine="147"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="317" Column="35" TopLine="293"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="342" Column="14" TopLine="318"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="419" Column="31" TopLine="395"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="47" Column="22" TopLine="32"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="317" Column="35" TopLine="293"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="168" Column="14" TopLine="68"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="347" Column="19" TopLine="377"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="231" Column="10" TopLine="217"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="264" Column="77" TopLine="245"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="9" Column="22"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="25" Column="19" TopLine="7"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="337" Column="9" TopLine="321"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="334" Column="31" TopLine="325"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="66" Column="62" TopLine="47"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="61" Column="55" TopLine="47"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="66" Column="62" TopLine="47"/> + </Position> + <Position> + <Filename Value="Unit1.pas"/> + <Caret Line="318" Column="9" TopLine="314"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="53" Column="17" TopLine="47"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="59" Column="10" TopLine="47"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="63" Column="12" TopLine="47"/> + </Position> + <Position> + <Filename Value="unit2.pas"/> + <Caret Line="67" Column="68" TopLine="47"/> + </Position> + </JumpHistory> + <RunParams> + <FormatVersion Value="2"/> + <Modes ActiveMode=""/> + </RunParams> + </ProjectSession> +</CONFIG> diff --git a/Занимательное программирование/7/6_tetris/Unit1.lfm b/Занимательное программирование/7/6_tetris/Unit1.lfm new file mode 100644 index 0000000..c11d25a --- /dev/null +++ b/Занимательное программирование/7/6_tetris/Unit1.lfm @@ -0,0 +1,89 @@ +object Form1: TForm1 + Left = 458 + Height = 603 + Top = 240 + Width = 275 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'Тетрис' + ClientHeight = 603 + ClientWidth = 275 + Color = clBtnFace + DesignTimePPI = 120 + Font.Color = clWindowText + Font.Height = -14 + Font.Name = 'MS Sans Serif' + LCLVersion = '4.6.0.0' + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnKeyUp = FormKeyUp + object Screen: TImage + Left = 0 + Height = 550 + Top = 0 + Width = 275 + end + object BackBuffer: TImage + Left = 0 + Height = 550 + Top = 20 + Width = 275 + Visible = False + end + object Label1: TLabel + Left = 7 + Height = 25 + Top = 560 + Width = 65 + Caption = 'Линий:' + Font.Color = clWindowText + Font.Height = -20 + Font.Name = 'MS Sans Serif' + ParentFont = False + end + object LinesLabel: TLabel + Left = 80 + Height = 25 + Top = 560 + Width = 11 + Caption = '0' + Font.Color = clWindowText + Font.Height = -20 + Font.Name = 'MS Sans Serif' + ParentFont = False + end + object Label2: TLabel + Left = 127 + Height = 25 + Top = 560 + Width = 53 + Caption = 'Очки:' + Font.Color = clWindowText + Font.Height = -20 + Font.Name = 'MS Sans Serif' + ParentFont = False + end + object ScoreLabel: TLabel + Left = 193 + Height = 25 + Top = 560 + Width = 11 + Caption = '0' + Font.Color = clWindowText + Font.Height = -20 + Font.Name = 'MS Sans Serif' + ParentFont = False + end + object ImageList: TImageList + Height = 22 + Width = 22 + Left = 50 + Top = 40 + Bitmap = { + 4C7A0500000016000000160000002F0000000000000078DAEDD8310100300C02 + 30A4571ACE36193C3962226D5F0180A9E401006B170060EC7200C098200080BD + 0F140E46F1 + } + end +end diff --git a/Занимательное программирование/7/6_tetris/Unit1.pas b/Занимательное программирование/7/6_tetris/Unit1.pas new file mode 100644 index 0000000..91fd894 --- /dev/null +++ b/Занимательное программирование/7/6_tetris/Unit1.pas @@ -0,0 +1,438 @@ +unit Unit1; + +{$MODE objfpc}{$H+} + +interface + +uses + LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls, + Unit2, Math, Dialogs; + +type + + { TForm1 } + + TForm1 = class(TForm) + Label2: TLabel; + ScoreLabel: TLabel; + Screen: TImage; + ImageList: TImageList; + BackBuffer: TImage; + Label1: TLabel; + LinesLabel: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); + + private + { Private declarations } + public + { Public declarations } + end; + + TGameHandler = class(TInterfacedObject, IGameHandler) + private + Finished: Boolean; + public + CurX, CurY: Integer; { координаты текущей фигуры } + CurPiece: Integer; { ее идентификатор } + CurColour: Integer; { и цвет } + v: Integer; { счетчик кадров } + + constructor Create; + + procedure DoIteration; + procedure Reset; + procedure Finish; + function IsFinished: Boolean; + end; + +var + Form1: TForm1; + ActionThread: TActionThread; + Lines, Score: Integer; { количество собранных линий } + Level: Integer; + +implementation + +{$R *.lfm} + +{ поворот фигуры на 90 градусов } +procedure Rotate90(piece : Integer); +var + i, j: Integer; + temp: array[0..3, 0..3] of Integer; { "временная" фигура } +begin + for i := 0 to 3 do { поворот на 90 градусов по часовой стрелке } + for j := 0 to 3 do + temp[3 - j, i] := Pieces[piece, i, j]; + + for i := 0 to 3 do { копируем измененную фигуру в исходный массив } + for j := 0 to 3 do + Pieces[piece, i, j] := temp[i, j] +end; + +{ сдвиг фигуры в угол } +procedure ToCorner(piece : Integer); +var + i, j: Integer; +label exit1, exit2; +begin + { цикл вертикального сдвига } + while true do + begin + for i := 0 to 3 do { если больше не надо двигать вверх } + if Pieces[piece, i, 0] = 1 then + { переходим к горизонтальному сдвигу } + goto exit1; + { иначе сдвигаем на клетку вверх } + for i := 0 to 3 do + for j := 0 to 2 do + Pieces[piece, i, j] := Pieces[piece, i, j + 1]; + + for i := 0 to 3 do + Pieces[piece, i, 3] := 0; { нижний ряд заполняем нулями } + end; + +exit1: { аналогично: } + while true do { цикл горизонтального сдвига } + begin + for j := 0 to 3 do { если больше не надо двигать влево } + if Pieces[piece, 0, j] = 1 then + goto exit2; { выход } + + for j := 0 to 3 do { иначе сдвигаем на клетку влево } + for i := 0 to 2 do + Pieces[piece, i, j] := Pieces[piece, i + 1, j]; + + for j := 0 to 3 do + Pieces[piece, 3, j] := 0; { правый ряд заполняем нулями } + end; + +exit2: { конец работы } +end; + +{ загрузить "строительные блоки" } +procedure LoadBitmaps; +var + i: Integer; +begin + for i := 0 to 4 do + begin + Bitmaps[i] := TBitmap.Create; + Form1.ImageList.GetBitmap(i, Bitmaps[i]) + end +end; + +{ освободить память } +procedure FreeBitmaps; +var + i: Integer; +begin + for i := 0 to 4 do + Bitmaps[i].Free +end; + +{ инициализация игрового поля } +procedure InitField; +var + i, j: Integer; +begin + { Заполняем собственно поле нулями } + { (соответствующими свободному пространству). } + for i := 0 to FieldWidth - 1 do + for j := 0 to FieldHeight - 1 do + begin + Field[i, j] := 0; + { Очистка экрана. } + Form1.BackBuffer.Canvas.Draw(22*i, 22*j, Bitmaps[0]) + end; + + { Помечаем участки, находящиеся под "стаканом", как занятые. } + for i := 0 to FieldWidth - 1 do + Field[i, FieldHeight] := 1; + + { Таким же образом помечаем участки слева и справа от поля. } + for j := 0 to FieldHeight do + begin + Field[-1, j] := 1; + Field[FieldWidth, j] := 1 + end +end; + +procedure InitLevel(ALevel: Integer); +begin + InitField; { очистка игрового поля } + { Пока не собрано ни одной линии. } + Lines := 0; + Level := ALevel +end; + +{ Рисование фигуры. } +procedure DrawPiece(x, y, piece, colour : Integer); +var + i, j: Integer; +begin + for i := 0 to 3 do + for j := 0 to 3 do + if Pieces[piece, i, j] = 1 then + begin + { рисуем очередной "строительный блок" } + Form1.BackBuffer.Canvas.Draw(22*(x + i), 22*(y + j), Bitmaps[colour]); + Field[x + i, y + j] := colour { вносим изменения в игровое поле } + end +end; + +{-------------------------------------------------------------} +{ Можно ли поместить фигуру в (x, y)? } +function CanPlace(x, y, piece : Integer) : Boolean; +var + i, j: Integer; +begin + for i := 0 to 3 do + for j := 0 to 3 do + if (Pieces[piece, i, j] = 1) and (Field[x + i, y + j] <> 0) then + begin + CanPlace := false; { участок фигуры накладывается на } + Exit { занятую клетку поля; запрещаем действие } + end; + CanPlace := true { пересечений не обнаружено } +end; + +{ Сдвиг поля (уничтожение линий). } +procedure ShiftField; +var + i, j: Integer; + fullrow: Boolean; + curline: Integer; + LinesAtOnce: Integer; +begin + curline := FieldHeight - 1; { текущая линия (начинаем с нижней) } + LinesAtOnce := 0; + { Идем до самого верха. } + while curline >= 0 do + begin + { Определяем, собрана линия целиком или нет. } + fullrow := true; + for i := 0 to FieldWidth - 1 do + { Если поле в текущей строке содержит } + { хотя бы один нуль, линия не собрана } + if Field[i, curline] = 0 then + begin + fullrow := false; + Break + end; + + { если линия собрана } + if fullrow then + begin + { Увеличиваем кол-во собранных линий. } + Inc(LinesAtOnce); + + for i := 0 to FieldWidth - 1 do { сдвигаем верхнюю часть } + for j := curline downto 1 do { поля вниз } + Field[i, j] := Field[i, j - 1]; + + { сдвигаем вниз также изображение на экране } + Form1.BackBuffer.Canvas.CopyRect(Rect(0, 22, 220, 22*(curline+1)), + Form1.BackBuffer.Canvas, Rect(0, 0, 220, 22*(curline))); + + { Самая верхняя строка поля теперь пуста. } + for i := 0 to FieldWidth - 1 do + begin + Field[i, 0] := 0; { заполняем ее нулями } + { на экране нулям соответствует фоновый цвет } + Form1.BackBuffer.Canvas.Draw(22*i, 0, Bitmaps[0]) + end; + end + else + { Если линия не собрана, переходим к следующей. } + curline := curline - 1 + end; + Inc(Lines, LinesAtOnce); + if LinesAtOnce = 1 then + Inc(Score, 1) + else if LinesAtOnce = 2 then + Inc(Score, 3) + else if LinesAtOnce = 3 then + Inc(Score, 5) + else if LinesAtOnce >= 4 then + Inc(Score, 7) +end; + +{-------------------------------------------------------------} + +procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + case Key of + VK_SPACE: + Key_Space := true; + VK_LEFT: + Key_Left := true; + VK_RIGHT: + Key_Right := true; + VK_DOWN: + Key_Down := true + end +end; + +{-------------------------------------------------------------} +procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + case Key of + VK_SPACE: + Key_Space := false; + VK_LEFT: + Key_Left := false; + VK_RIGHT: + Key_Right := false; + VK_DOWN: + Key_Down := false + end +end; + +{-------------------------------------------------------------} +procedure TForm1.FormCreate(Sender: TObject); +var + GameHandler: TGameHandler; +begin + Randomize; + LoadBitmaps; { загрузка "строительных блоков" } + + GameHandler := TGameHandler.Create; + + Key_Space := false; { считаем, что клавиши изначально не нажаты } + Key_Left := false; + Key_Right := false; + Key_Down := false; + + ActionThread := TActionThread.Create(GameHandler); + Score := 0; + InitLevel(1) +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + ActionThread.GameHandler.Finish; + ActionThread.WaitFor; + FreeAndNil(ActionThread); + + FreeBitmaps { освобождение памяти } +end; + +constructor TGameHandler.Create; +begin + Finished := false; + Reset +end; + +procedure TGameHandler.DoIteration; +begin + if Lines > LinesPerLevel then + begin + SuspendThread(ActionThread.ThreadID); + ShowMessage('Переход на уровень ' + IntToStr(Level + 1)); + InitLevel(Level + 1); + Reset; + ResumeThread(ActionThread.ThreadID); + Exit + end; + if CurY = -1 then { если на экране нет движущихся фигур } + begin + CurY := 0; { создаем новую фигуру } + CurX := FieldWidth div 2; { в верхней части экрана } + CurPiece := 1 + Random(7); { ее тип и цвет выбираются } + CurColour := 1 + Random(4); { случайным образом } + + { если ее нельзя разместить, конец игры } + if not CanPlace(CurX, CurY, CurPiece) then + begin + Finish; + Exit + end + end; + + DrawPiece(CurX, CurY, CurPiece, 0); { стираем фигуру с экрана } + + { если нажата клавиша "вниз", увеличиваем скорость игры } + if Key_Down then + MSecsPerFrame := 20 + else + MSecsPerFrame := 100; + + if Key_Left and CanPlace(CurX - 1, CurY, CurPiece) then + CurX := CurX - 1; { сдвиг фигуры влево } + if Key_Right and CanPlace(CurX + 1, CurY, CurPiece) then + CurX := CurX + 1; { сдвиг фигуры вправо } + + if Key_Space then { поворот фигуры } + begin + Rotate90(CurPiece); { поворачиваем на 90 градусов } + ToCorner(CurPiece); + { Если фигуру нельзя разместить возвращаем ее } + { в первоначальное положение (повернуть еще три раза). } + if not CanPlace(CurX, CurY, CurPiece) then + begin + Rotate90(CurPiece); + Rotate90(CurPiece); + Rotate90(CurPiece); + ToCorner(CurPiece) + end + end; + + v := v + 1; { увеличиваем счетчик кадров } + + { Если на текущей итерации нет вертикального сдвига. } + if v <> Max(1, Delay - Level) then + DrawPiece(CurX, CurY, CurPiece, CurColour) + else + { Рисуем фигуру иначе. } + begin + v := 0; { обнуляем счетчик } + if CanPlace(CurX, CurY + 1, CurPiece) then + begin + CurY := CurY + 1; { если фигуру можно разместить } + DrawPiece(CurX, CurY, CurPiece, CurColour) { размещаем } + end + else { иначе } + begin + { оставляем на прежнем месте } + DrawPiece(CurX, CurY, CurPiece, CurColour); + ShiftField; { уничтожаем собранные линии } + CurY := -1 { на экране больше нет движущихся фигур } + end + end; + + { Обновляем содержимое экрана (копируем буфер на экран). } + Form1.Screen.Canvas.CopyRect(Rect(0, 0, 220, 440), + Form1.BackBuffer.Canvas, Rect(0, 0, 220, 440)); + + { Обновляем индикатор количества собранных линий. } + Form1.LinesLabel.Caption := IntToStr(Lines); + Form1.ScoreLabel.Caption := IntToStr(Score) +end; + +procedure TGameHandler.Reset; +begin + { Текущее значение Y-координаты, равное -1 служит индикатором } + { отсутствия движущихся фигур инициализация переменных. } + CurY := -1; + + v := 0; + CurPiece := 0; + CurX := 0; + CurColour := 0 +end; + +procedure TGameHandler.Finish; +begin + Finished := true +end; + +function TGameHandler.IsFinished: Boolean; +begin + Result := Finished +end; + +end. diff --git a/Занимательное программирование/7/6_tetris/pics.bmp b/Занимательное программирование/7/6_tetris/pics.bmp new file mode 100644 index 0000000000000000000000000000000000000000..35500fd2c332f4af36d60bbd5845d6ddef6b0161 GIT binary patch literal 1350 zcmZ?rbz@}!gEAng0mOMgEC$4k3@kvBf#Cv>I>*Pra07@@K?4H=5HU0~Kqw#yWHKB$ zZ~#byB>saD!~g#v77zm=NC-%jBfv}qP(pxE1UQ2LqxulR5{d|xGo#@$8ZL-zG!v1H Llt#maF5v<IwUSF< literal 0 HcmV?d00001 diff --git a/Занимательное программирование/7/6_tetris/unit2.pas b/Занимательное программирование/7/6_tetris/unit2.pas new file mode 100644 index 0000000..2ac9fea --- /dev/null +++ b/Занимательное программирование/7/6_tetris/unit2.pas @@ -0,0 +1,78 @@ +unit Unit2; + +{$mode ObjFPC} + +interface + +uses + Classes, SysUtils, Graphics; + +type + IGameHandler = interface + procedure DoIteration; + procedure Reset; + procedure Finish; + function IsFinished: Boolean; + end; + + TActionThread = class(TThread) + public + GameHandler: IGameHandler; + + constructor Create(AGameHandler: IGameHandler); + procedure Execute; override; + end; + +const + FieldHeight = 20; + FieldWidth = 10; { высота и ширина игрового поля } + Delay = 6; { Задержка падения фигуры (в кадрах). } + LinesPerLevel = 10; + +var + ActionThread: TActionThread; + MSecsPerFrame: Integer; { миллисекунд на кадр } + + Key_Space, Key_Left, Key_Right, Key_Down: Boolean; { состояния клавиш } + Bitmaps: array[0..4] of TBitmap; { "строительные блоки" } + Field: array[-1..FieldWidth, 0..FieldHeight] of Integer; { игровое поле } + Pieces: array[1..7, 0..3, 0..3] of Integer = ( + ((1,1,1,1), (0,0,0,0), (0,0,0,0), (0,0,0,0)), + ((1,1,0,0), (0,1,1,0), (0,0,0,0), (0,0,0,0)), + ((1,1,1,0), (0,0,1,0), (0,0,0,0), (0,0,0,0)), + ((1,1,0,0), (1,1,0,0), (0,0,0,0), (0,0,0,0)), + ((1,0,0,0), (1,1,0,0), (1,0,0,0), (0,0,0,0)), + ((0,0,1,0), (1,1,1,0), (0,0,0,0), (0,0,0,0)), + ((0,1,1,0), (1,1,0,0), (0,0,0,0), (0,0,0,0)) + ); + +implementation + +constructor TActionThread.Create(AGameHandler: IGameHandler); +begin + inherited Create(false); + GameHandler := AGameHandler +end; + +procedure TActionThread.Execute; +var + OldTime: TDateTime; + ToWait: Integer; +begin + while not GameHandler.IsFinished do + begin + OldTime := Now; + Synchronize(@GameHandler.DoIteration); + { Синхронизация с таймером. } + ToWait := Round(MSecsPerFrame - (Now - OldTime) * MSecsPerDay); + if ToWait > 0 then + Sleep(ToWait) + end; +end; + +exports + MSecsPerFrame, Bitmaps, Field, Pieces, + Key_Space, Key_Left, Key_Right, Key_Down; + +end. +