1 files changed, 331 insertions, 0 deletions
diff --git a/Занимательное программирование/7/2_minesweeper/unit1.pas b/Занимательное программирование/7/2_minesweeper/unit1.pas
new file mode 100644
index 0000000..d374f67
--- /dev/null
+++ b/Занимательное программирование/7/2_minesweeper/unit1.pas
@@ -0,0 +1,331 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls,
+  Menus, ExtCtrls;
+
+const
+  DefaultFieldWidth = 16; { Ширина поля }
+  DefaultFieldHeight = 16; { Высота поля }
+  CellSize = 24;
+  CellsPerMine = 6; { Среднее значение количества клеток на одну мину }
+
+type
+  { "Доработанная" кнопка }
+  MySpeedButton = class(TSpeedButton)
+  public
+    x, y: Integer; { Её положение на игровом поле }
+    Uncovered: Boolean; { Нажата или нет }
+    IsMine: Boolean; { Находится ли в ней мина }
+    Flagged: Boolean; { Помечена флажком }
+    Clicked: Boolean;
+    procedure Uncover;
+    procedure Flag;
+    { Обработчик события Click }
+    procedure MouseLeave; override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer); override;
+  end;
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Button1: TButton;
+    ImageList: TImageList;
+    BestTimes: TMenuItem;
+    TimerLabel: TLabel;
+    MainMenu1: TMainMenu;
+    Game: TMenuItem;
+    Beginner: TMenuItem;
+    Intermediate: TMenuItem;
+    Expert: TMenuItem;
+    Status: TLabel;
+    Timer1: TTimer;
+    procedure BeginnerClick(Sender: TObject);
+    procedure BestTimesClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+    procedure ExpertClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure IntermediateClick(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  { Игровое поле (двумерный массив кнопок) }
+  Field: array of array of MySpeedButton;
+  GameOver: Boolean = false; { Индикатор конца игры }
+  Mines: Integer; { Количество мин }
+  Opened: Integer; { Количество открытых клеток }
+  Form1: TForm1;
+  Results: array[1..3] of Integer;
+
+{ Создание игрового поля }
+procedure MakeButtons(AFieldWidth, AFieldHeight: Integer);
+procedure StartGame;
+{ Конец игры }
+procedure EndGame;
+procedure FreeField;
+
+implementation
+
+{$R *.lfm}
+
+{ MySpeedButton }
+
+{ Обработка щелчка на кнопке }
+procedure MySpeedButton.Uncover;
+var
+  c: Integer;
+  i, j: Integer;
+  dx, dy: Integer;
+begin
+  { Теперь кнопка точно нажата }
+  Uncovered := true;
+  { Если в ней оказалась мина }
+  if IsMine then
+  begin
+    GameOver := true;
+    Form1.Status.Caption := 'Поражения!';
+    { Выводим изображение мины (9) }
+    Form1.ImageList.GetBitmap(9, Glyph)
+  end
+  else
+  begin
+    c := 0;
+    for dx := -1 to 1 do
+      for dy := -1 to 1 do
+        { Клетка сама себе не сосед }
+        if not ((dx = 0) and (dy = 0)) then
+        begin
+          { Координаты текущего соседа }
+          i := x + dx;
+          j := y + dy;
+          { Если сосед не за пределами поля, учитываем его }
+          { Integer(Field[i, j].IsMine) = 1, если есть мина. }
+          { Integer(Field[i, j].IsMine) = 0 в противном случае }
+          if (i >= 0) and (j >= 0) and (i < Length(Field)) and (j < Length(Field[0])) then
+            c := c + Integer(Field[i, j].IsMine);
+        end;
+    Form1.ImageList.GetBitmap(c, Glyph); { Рисуем требуемую картинку }
+    { Мы открыли еще одну клетку }
+    Opened := Opened + 1;
+    { Открыты все безопасные клетки }
+    if Opened + Mines = Length(Field) * Length(Field[0]) then
+      EndGame;
+    if c = 0 then
+      for dx := -1 to 1 do
+        for dy := -1 to 1 do
+          { Клетка сама себе не сосед }
+          if not ((dx = 0) and (dy = 0)) then
+          begin
+            { Координаты текущего соседа }
+            i := x + dx;
+            j := y + dy;
+            if (i >= 0) and (j >= 0) and (i < Length(Field)) and (j < Length(Field[0])) and not Field[i, j].Uncovered then
+              Field[i, j].Uncover
+          end
+  end;
+end;
+
+procedure MySpeedButton.Flag;
+begin
+  if Flagged then
+  begin
+    Flagged := false;
+    Glyph := nil
+  end
+  else
+  begin
+    Flagged := true;
+    Form1.ImageList.GetBitmap(10, Glyph)
+  end
+end;
+
+procedure MySpeedButton.MouseLeave;
+begin
+  Inherited;
+  Clicked := false
+end;
+
+procedure MySpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer);
+begin
+  if (Button = mbLeft) or (Button = mbRight) then
+     Clicked := true
+end;
+
+procedure MySpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer);
+begin
+  { Если кнопка уже нажата или игра закончена, не обрабатываем }
+  if GameOver or Uncovered or not Clicked then Exit;
+
+  if (Button = mbLeft) and not Flagged then
+    Uncover
+  else if Button = mbRight then
+    Flag
+end;
+
+procedure StartGame;
+var
+  i, j: Integer;
+begin
+  { Строка статуса изначально пуста }
+  Form1.Status.Caption := '';
+  { Счетчик мин }
+  Mines := 0;
+  { Счетчик открытых клеток }
+  Opened := 0;
+  { Еще не конец игры }
+  GameOver := false;
+
+  for i := 0 to High(Field) do
+    for j := 0 to High(Field[i]) do
+    begin
+      { Пока на кнопках нет картинок }
+      Field[i, j].Glyph := nil;
+      { и ни одна из них не нажата }
+      Field[i, j].Uncovered := false;
+      { и не помечена }
+      Field[i, j].Flagged := false;
+      Field[i, j].Clicked := false;
+
+      { С вероятностью 1/CellsPerMine }
+      if Random(CellsPerMine) = 0 then
+      begin
+        { Размещаем мину }
+        Field[i, j].IsMine := true;
+        Mines := Mines + 1
+      end
+      else
+      begin
+        { иначе клетка безопасна }
+        Field[i, j].IsMine := false
+      end
+    end
+end;
+
+procedure EndGame;
+begin
+  GameOver := true;
+  Form1.Status.Caption := 'Победа!';
+
+  if Length(Field) = 9 then
+    if Form1.Timer1.Tag < Results[1] then
+       Results[1] := Form1.Timer1.Tag
+  else if Length(Field) = 16 then
+    if Form1.Timer1.Tag < Results[2] then
+      Results[2] := Form1.Timer1.Tag
+  else if Length(Field) = 20 then
+    if Form1.Timer1.Tag < Results[3] then
+      Results[3] := Form1.Timer1.Tag
+end;
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Randomize;
+  Results[1] := 999999;
+  Results[2] := 999999;
+  Results[3] := 999999;
+  { При запуске программы создаем кнопки }
+  MakeButtons(DefaultFieldWidth, DefaultFieldHeight);
+  StartGame
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  StartGame;
+end;
+
+procedure TForm1.ExpertClick(Sender: TObject);
+begin
+  MakeButtons(20, 25);
+  StartGame
+end;
+
+procedure TForm1.BeginnerClick(Sender: TObject);
+begin
+  MakeButtons(9, 9);
+  StartGame
+end;
+
+procedure TForm1.BestTimesClick(Sender: TObject);
+begin
+  ShowMessage('Новичок: ' + Results[1].ToString + sLineBreak +
+      'Нормальный: ' + Results[2].ToString + sLineBreak +
+      'Эксперт: ' + Results[3].ToString)
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  FreeField;
+  Inherited
+end;
+
+procedure TForm1.IntermediateClick(Sender: TObject);
+begin
+  MakeButtons(DefaultFieldWidth, DefaultFieldHeight);
+  StartGame
+end;
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+var
+  Minutes, Seconds: Integer;
+begin
+  Minutes := Timer1.Tag div 60;
+  Seconds := Timer1.Tag mod 60;
+
+  if Seconds > 9 then
+    TimerLabel.Caption := Minutes.ToString + ':' + Seconds.ToString
+  else
+    TimerLabel.Caption := Minutes.ToString + ':0' + Seconds.ToString;
+
+  Timer1.Tag := Timer1.Tag + 1
+end;
+
+procedure FreeField;
+var
+  i, j: Integer;
+begin
+  for i := 0 to High(Field) do
+    for j := 0 to High(Field[i]) do
+      Field[i, j].Free
+end;
+
+procedure MakeButtons(AFieldWidth, AFieldHeight: Integer);
+var
+  i, j: Integer;
+begin
+  FreeField;
+  SetLength(Field, AFieldWidth, AFieldHeight);
+  for i := 0 to AFieldWidth - 1 do
+    for j := 0 to AFieldHeight - 1 do
+    begin
+      Field[i, j] := MySpeedButton.Create(nil); { Создать кнопку }
+      with Field[i, j] do
+      begin
+        { Указываем координаты кнопки }
+        Left := i * CellSize;
+        Top := j * CellSize;
+        { Указываем размеры кнопки }
+        Width := CellSize;
+        Height := CellSize;
+        Parent := Form1; { а также родительскую форму }
+        { x, y - Позиция кнопки на игровом поле }
+        x := i;
+        y := j
+      end
+    end;
+end;
+
+end.
+