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