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

1 files changed, 429 insertions, 0 deletions

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