From ee8f910cb0a2761d77a13fb4423a157a6d64b19c Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Mon, 20 Apr 2026 14:55:53 +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=20Columns=20=D0=B8=D0=B7=207-=D0=B9=20=D0=B3=D0=BB=D0=B0?= =?UTF-8?q?=D0=B2=D1=8B,=20=D1=81=D0=B5=D0=B4=D1=8C=D0=BC=D0=BE=D0=B3?= =?UTF-8?q?=D0=BE=20=D1=83=D0=BF=D1=80=D0=B0=D0=B6=D0=BD=D0=B5=D0=BD=D0=B8?= =?UTF-8?q?=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/7_columns/columns.lpi | 84 ++++ .../7/7_columns/columns.lpr | 28 ++ .../7/7_columns/columns.lps | 182 ++++++++ .../7/7_columns/unit1.lfm | 65 +++ .../7/7_columns/unit1.pas | 429 ++++++++++++++++++ .../7/7_columns/unit2.pas | 86 ++++ 6 files changed, 874 insertions(+) create mode 100644 Занимательное программирование/7/7_columns/columns.lpi create mode 100644 Занимательное программирование/7/7_columns/columns.lpr create mode 100644 Занимательное программирование/7/7_columns/columns.lps create mode 100644 Занимательное программирование/7/7_columns/unit1.lfm create mode 100644 Занимательное программирование/7/7_columns/unit1.pas create mode 100644 Занимательное программирование/7/7_columns/unit2.pas diff --git a/Занимательное программирование/7/7_columns/columns.lpi b/Занимательное программирование/7/7_columns/columns.lpi new file mode 100644 index 0000000..74d67fa --- /dev/null +++ b/Занимательное программирование/7/7_columns/columns.lpi @@ -0,0 +1,84 @@ + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </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="columns.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit> + <Unit> + <Filename Value="unit2.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Unit2"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="columns"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </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/7_columns/columns.lpr b/Занимательное программирование/7/7_columns/columns.lpr new file mode 100644 index 0000000..a79c619 --- /dev/null +++ b/Занимательное программирование/7/7_columns/columns.lpr @@ -0,0 +1,28 @@ +program columns; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1, Unit2 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + {$PUSH}{$WARN 5044 OFF} + Application.MainFormOnTaskbar:=True; + {$POP} + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/Занимательное программирование/7/7_columns/columns.lps b/Занимательное программирование/7/7_columns/columns.lps new file mode 100644 index 0000000..b750648 --- /dev/null +++ b/Занимательное программирование/7/7_columns/columns.lps @@ -0,0 +1,182 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <Version Value="12"/> + <BuildModes Active="Default"/> + <Units> + <Unit> + <Filename Value="columns.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="61"/> + </Unit> + <Unit> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + <IsVisibleTab Value="True"/> + <TopLine Value="271"/> + <CursorPos Y="299"/> + <UsageCount Value="61"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit> + <Unit> + <Filename Value="unit2.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Unit2"/> + <EditorIndex Value="1"/> + <CursorPos X="14" Y="8"/> + <UsageCount Value="61"/> + <Loaded Value="True"/> + </Unit> + <Unit> + <Filename Value="/usr/share/lazarus/lcl/interfaces/qt5/qtobject.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="920"/> + <CursorPos X="26" Y="950"/> + <UsageCount Value="7"/> + </Unit> + <Unit> + <Filename Value="/usr/src/fpc-3.2.2/packages/fcl-image/src/fpcanvas.pp"/> + <UnitName Value="FPCanvas"/> + <EditorIndex Value="-1"/> + <TopLine Value="328"/> + <CursorPos X="20" Y="377"/> + <UsageCount Value="8"/> + </Unit> + </Units> + <JumpHistory HistoryIndex="29"> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="179" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="221" TopLine="170"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="177" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="179" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="221" TopLine="170"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="177" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="179" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="221" TopLine="170"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="177" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="179" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="221" TopLine="170"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="177" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="179" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="221" TopLine="170"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="177" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="179" TopLine="169"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="221" TopLine="170"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="233" Column="7" TopLine="179"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="164" Column="41" TopLine="148"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="242" Column="23" TopLine="195"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="220" Column="27" TopLine="212"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="51" Column="28" TopLine="49"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="301" Column="30" TopLine="297"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="310" Column="14" TopLine="276"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="301" Column="37" TopLine="264"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="283" Column="19" TopLine="272"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="301" Column="13" TopLine="271"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="23" Column="15"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="24" Column="15"/> + </Position> + <Position> + <Filename Value="unit1.pas"/> + <Caret Line="301" Column="9" TopLine="258"/> + </Position> + </JumpHistory> + <RunParams> + <FormatVersion Value="2"/> + <Modes ActiveMode=""/> + </RunParams> + </ProjectSession> +</CONFIG> diff --git a/Занимательное программирование/7/7_columns/unit1.lfm b/Занимательное программирование/7/7_columns/unit1.lfm new file mode 100644 index 0000000..d5b04e1 --- /dev/null +++ b/Занимательное программирование/7/7_columns/unit1.lfm @@ -0,0 +1,65 @@ +object Form1: TForm1 + Left = 548 + Height = 1018 + Top = 198 + Width = 669 + Caption = 'Form1' + ClientHeight = 1018 + ClientWidth = 669 + DesignTimePPI = 144 + LCLVersion = '4.6.0.0' + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnKeyUp = FormKeyUp + object Screen: TImage + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrCenter + Left = 34 + Height = 800 + Top = 0 + Width = 600 + end + object BackBuffer: TImage + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrCenter + Left = 34 + Height = 800 + Top = 0 + Width = 600 + end + object ScoreLabel1: TLabel + AnchorSideLeft.Control = Screen + AnchorSideTop.Control = Screen + AnchorSideTop.Side = asrBottom + Left = 34 + Height = 39 + Top = 825 + Width = 69 + BorderSpacing.Top = 25 + Caption = 'Счет:' + Font.Height = -28 + Font.Name = 'Noto Sans' + ParentFont = False + end + object ScoreLabel: TLabel + AnchorSideLeft.Control = ScoreLabel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ScoreLabel1 + Left = 123 + Height = 39 + Top = 825 + Width = 16 + BorderSpacing.Left = 20 + Caption = '0' + Font.Height = -28 + Font.Name = 'Noto Sans' + ParentFont = False + end +end diff --git a/Занимательное программирование/7/7_columns/unit1.pas b/Занимательное программирование/7/7_columns/unit1.pas new file mode 100644 index 0000000..5cffa77 --- /dev/null +++ b/Занимательное программирование/7/7_columns/unit1.pas @@ -0,0 +1,429 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, + Unit2, LCLType; + +const + { Ширина и высота игрового поля. } + FieldWidth = 10; + FieldHeight = 20; + CellSize = 30; + Delay = 3; { Задержка падения фигуры в кадрах. } + +type + + { TForm1 } + + TForm1 = class(TForm) + ScoreLabel1: TLabel; + ScoreLabel: TLabel; + Screen: TImage; + BackBuffer: TImage; + 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 + + public + + end; + + TGameHandler = class Sealed(IGameHandler) + private + v: Integer; { Счетчик кадров. } + public + procedure DoIteration; override; + end; + +var + Form1: TForm1; + ActionThread: TActionThread; + Field: array[-1..FieldWidth, 0..FieldHeight] of Integer; { Игровое поле. } + { Состояния клавиш. } + PressedSpace, PressedLeft, PressedRight, PressedDown: Boolean; + CurrentColor: array[1..3] of Integer; + CurrentX, CurrentY, Score: Integer; + +implementation + +{$R *.lfm} + +{ Изменение размера поля в зависимости от количества и величины клеток. } +procedure ResizeField; +begin + Form1.Screen.Width := CellSize * FieldWidth; + Form1.Screen.Height := CellSize * FieldHeight; + Form1.BackBuffer.Width := Form1.Screen.Width; + Form1.BackBuffer.Height := Form1.Screen.Height +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.Clear + 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; + +{ Можно ли поместить фигуру в (x, y)? } +function CanPlace(x, y: Integer): Boolean; +var + i: Integer; +begin + for i := 0 to 2 do + if Field[x, y + i] <> 0 then + begin + Result := false; + Exit + end; + Result := true +end; + +procedure DrawPiece(x, y: Integer; Color: array of Integer); +var + i: Integer; + BrushColor: TColor; +begin + for i := 0 to 2 do + begin + case Color[i] of + 0: + BrushColor := clWhite; + 1: + BrushColor := clGreen; + 2: + BrushColor := clBlue; + 3: + BrushColor := clYellow; + 4: + BrushColor := clRed + end; + + Form1.BackBuffer.Canvas.Brush.Color := BrushColor; + Form1.BackBuffer.Canvas.FillRect(x * CellSize, (y + i) * CellSize, + (x + 1) * CellSize - 1, (y + i + 1) * CellSize - 1); + Field[x, y + i] := Color[i] + end +end; + +procedure DrawPiece(x, y: Integer); +var + ClearColor: array[1..3] of Integer; + i: Integer; +begin + for i := 1 to High(ClearColor) do + ClearColor[i] := 0; + DrawPiece(x, y, ClearColor) +end; + +{ Цвет фигуры выбирается случайным образом. } +procedure RandomizeColor; +var + i: Integer; +begin + for i := 1 to High(CurrentColor) do + CurrentColor[i] := Random(4) + 1 +end; + +procedure MoveColors; +var + TemporaryColor: Integer; +begin + TemporaryColor := CurrentColor[1]; + CurrentColor[1] := CurrentColor[3]; + CurrentColor[3] := CurrentColor[2]; + CurrentColor[2] := TemporaryColor +end; + +{ Сдвиг поля (уничтожение линий). } +function ShiftFieldHorizontally: Integer; +var + CurrentLine, CurrentColumn: Integer; + i, j: Integer; + OfSameColor: Cardinal; + LastColor: Integer; +begin + { Начинаем в левом нижнем углу. } + CurrentLine := FieldHeight - 1; + CurrentColumn := 0; + OfSameColor := 0; + LastColor := 0; + Result := 0; + + while CurrentLine >= 0 do + begin + while CurrentColumn < FieldWidth do + begin + if (Field[CurrentColumn, CurrentLine] = LastColor) and (LastColor <> 0) then + Inc(OfSameColor) + else + begin + LastColor := Field[CurrentColumn, CurrentLine]; + + if OfSameColor >= 3 then + begin + Inc(Result); + + { Сдвигаем верхнюю часть поля вниз. } + for i := CurrentColumn - OfSameColor to CurrentColumn - 1 do + for j := CurrentLine downto 1 do + Field[i, j] := Field[i, j - 1]; + + { Сдвигаем вниз также изображение на экране. } + i := (CurrentColumn - OfSameColor) * CellSize; + j := CurrentColumn * CellSize - 1; + Form1.BackBuffer.Canvas.CopyRect( + Rect(i, CellSize, j, (CurrentLine + 1) * CellSize - 1), + Form1.BackBuffer.Canvas, + Rect(i, 0, j, CurrentLine * CellSize - 1) + ); + + { Самая верхняя строка поля теперь пуста. Заполняем ее нулями. } + Form1.BackBuffer.Canvas.Brush.Color := clWhite; + for i := CurrentColumn - OfSameColor to CurrentColumn - 1 do + begin + Field[i, 0] := 0; + Form1.BackBuffer.Canvas.FillRect(i * CellSize, 0, + (i + 1) * CellSize - 1, CellSize - 1) + end; + CurrentColumn := -1 + end; + + if LastColor = 0 then + OfSameColor := 0 + else + OfSameColor := 1 + end; + Inc(CurrentColumn) + end; + CurrentColumn := 0; + Dec(CurrentLine) + end +end; + +function ShiftFieldVertically: Integer; +var + CurrentColumn, CurrentLine: Integer; + LastColor: Integer; + OfSameColor: Cardinal; + i, j: Integer; +begin + Result := 0; + CurrentColumn := 0; + CurrentLine := FieldHeight - 1; + LastColor := 0; + OfSameColor := 0; + + while CurrentColumn < FieldWidth do + begin + while CurrentLine >= 0 do + begin + if (Field[CurrentColumn, CurrentLine] = LastColor) and (LastColor <> 0) then + Inc(OfSameColor) + else + begin + LastColor := Field[CurrentColumn, CurrentLine]; + + if OfSameColor >= 3 then + begin + Inc(Result); + + { Сдвигаем верхнюю часть поля вниз. } + for i := CurrentLine downto 0 do + Field[CurrentColumn, i + OfSameColor] := Field[CurrentColumn, i]; + + { Сдвигаем вниз также изображение на экране. } + i := (CurrentLine + OfSameColor + 1) * CellSize - 1; + j := (CurrentColumn + 1) * CellSize - 1; + Form1.BackBuffer.Canvas.CopyRect( + Rect(CurrentColumn * CellSize, OfSameColor * CellSize, j, i), + Form1.BackBuffer.Canvas, + Rect(CurrentColumn * CellSize, 0, j, (CurrentLine + 1) * CellSize - 1) + ); + + { Верхние строки поля теперь пустые. Заполняем ее нулями. } + Form1.BackBuffer.Canvas.Brush.Color := clWhite; + for i := 0 to OfSameColor - 1 do + begin + Field[CurrentColumn, i] := 0; + Form1.BackBuffer.Canvas.FillRect(CurrentColumn * CellSize, i * CellSize, + (CurrentColumn + 1) * CellSize - 1, (i + 1) * CellSize - 1) + end; + CurrentLine := FieldHeight + end; + + if LastColor = 0 then + OfSameColor := 0 + else + OfSameColor := 1 + end; + Dec(CurrentLine) + end; + CurrentLine := FieldHeight - 1; + Inc(CurrentColumn) + end +end; + +procedure ShiftField; +var + RoundScore: Integer; +begin + repeat + RoundScore := ShiftFieldHorizontally; + RoundScore := RoundScore + ShiftFieldVertically; + Score := Score + RoundScore + until RoundScore = 0; + + Form1.ScoreLabel.Caption := IntToStr(Score) +end; + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +var + GameHandler: TGameHandler; +begin + Score := 0; + Randomize; + + ResizeField; + InitField; + + { Текущее значение Y-координаты, равное -1 служит индикатором } + { отсутствия движущихся фигур инициализация переменных. } + CurrentX := -1; + CurrentY := -1; + + GameHandler := TGameHandler.Create; + ActionThread := TActionThread.Create(GameHandler) +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + ActionThread.GameHandler.Finished := true; + ActionThread.WaitFor; + FreeAndNil(ActionThread) +end; + +procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState + ); +begin + case Key of + VK_SPACE: + PressedSpace := true; + VK_LEFT: + PressedLeft := true; + VK_RIGHT: + PressedRight := true; + VK_DOWN: + PressedDown := true + end +end; + +procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + case Key of + VK_SPACE: + PressedSpace := false; + VK_LEFT: + PressedLeft := false; + VK_RIGHT: + PressedRight := false; + VK_DOWN: + PressedDown := false + end +end; + +procedure TGameHandler.DoIteration; +begin + { Если на экране нет движущихся фигур. } + if CurrentY = -1 then + begin + { Создаем новую фигуру в верхней части экрана. } + CurrentY := 0; + CurrentX := FieldWidth div 2; + RandomizeColor; + + { если ее нельзя разместить, конец игры } + if not CanPlace(CurrentX, CurrentY) then + begin + Finished := true; + Exit + end; + end; + + DrawPiece(CurrentX, CurrentY); { Стираем фигуру с экрана. } + + { Если нажата клавиша "вниз", увеличиваем скорость игры. } + if PressedDown then + SlowDown + else + SpeedUp; + + if PressedLeft and CanPlace(CurrentX - 1, CurrentY) then + Dec(CurrentX); { сдвиг фигуры влево } + if PressedRight and CanPlace(CurrentX + 1, CurrentY) then + Inc(CurrentX); { сдвиг фигуры вправо } + + { Прокручивание цветов. } + if PressedSpace then + MoveColors; + + Inc(v); { Увеличиваем счетчик кадров. } + + { Если на текущей итерации нет вертикального сдвига. } + if v < Delay then + DrawPiece(CurrentX, CurrentY, CurrentColor) + else + { Рисуем фигуру иначе. } + begin + if CanPlace(CurrentX, CurrentY + 1) then + begin + v := 0; + { Если фигуру можно разместить, размещаем. } + Inc(CurrentY); + DrawPiece(CurrentX, CurrentY, CurrentColor) + end + else + begin + { Иначе оставляем на прежнем месте. } + DrawPiece(CurrentX, CurrentY, CurrentColor); + ShiftField; { Уничтожаем собранные линии. } + CurrentY := -1 { На экране больше нет движущихся фигур. } + end + end; + + { Обновляем содержимое экрана (копируем буфер на экран). } + Form1.Screen.Canvas.CopyRect( + Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height), + Form1.BackBuffer.Canvas, + Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height)) +end; + +end. + diff --git a/Занимательное программирование/7/7_columns/unit2.pas b/Занимательное программирование/7/7_columns/unit2.pas new file mode 100644 index 0000000..d4f6f4f --- /dev/null +++ b/Занимательное программирование/7/7_columns/unit2.pas @@ -0,0 +1,86 @@ +unit Unit2; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils; + +const + StartMSecsPerFrame = 20; + +type + IGameHandler = class(TObject) + private + MSecsPerFrame: Integer; + + public + Finished: Boolean; + constructor Create; + procedure DoIteration; virtual; abstract; + + procedure SlowDown; + procedure SpeedUp; + end; + + TActionThread = class(TThread) + private + FGameHandler: IGameHandler; + + public + constructor Create(AGameHandler: IGameHandler); + destructor Destroy; + + property GameHandler: IGameHandler read FGameHandler; + + procedure Execute; override; + end; + +implementation + +constructor IGameHandler.Create; +begin + Finished := false; + MSecsPerFrame := StartMSecsPerFrame +end; + +procedure IGameHandler.SlowDown; +begin + MSecsPerFrame := StartMSecsPerFrame +end; + +procedure IGameHandler.SpeedUp; +begin + MSecsPerFrame := 100 +end; + +constructor TActionThread.Create(AGameHandler: IGameHandler); +begin + inherited Create(false); + FGameHandler := AGameHandler +end; + +destructor TActionThread.Destroy; +begin + FreeAndNil(FGameHandler) +end; + +procedure TActionThread.Execute; +var + OldTime: TDateTime; + ToWait: Integer; +begin + while not GameHandler.Finished do + begin + OldTime := Now; + Synchronize(@FGameHandler.DoIteration); + { Синхронизация с таймером. } + ToWait := Round(GameHandler.MSecsPerFrame - (Now - OldTime) * MSecsPerDay); + if ToWait > 0 then + Sleep(ToWait) + end +end; + +end. +