1 files changed, 248 insertions, 0 deletions
diff --git a/Занимательное программирование/7/1_minesweeper/unit1.pas b/Занимательное программирование/7/1_minesweeper/unit1.pas
new file mode 100644
index 0000000..d20aa7a
--- /dev/null
+++ b/Занимательное программирование/7/1_minesweeper/unit1.pas
@@ -0,0 +1,248 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls;
+
+const
+  FieldWidth = 20; { Ширина поля }
+  FieldHeight = 25; { Высота поля }
+  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;
+    Status: TLabel;
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  { Игровое поле (двумерный массив кнопок) }
+  Field: array[0..FieldWidth - 1, 0..FieldHeight - 1] of MySpeedButton;
+  GameOver: Boolean = false; { Индикатор конца игры }
+  Mines: Integer; { Количество мин }
+  Opened: Integer; { Количество открытых клеток }
+  Form1: TForm1;
+
+{ Создание игрового поля }
+procedure MakeButtons;
+procedure StartGame;
+
+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 < FieldWidth) and (j < FieldHeight) then
+            c := c + Integer(Field[i, j].IsMine);
+        end;
+    Form1.ImageList.GetBitmap(c, Glyph); { Рисуем требуемую картинку }
+    { Мы открыли еще одну клетку }
+    Opened := Opened + 1;
+    { Открыты все безопасные клетки }
+    if Opened + Mines = FieldWidth * FieldHeight then
+    begin
+      { Конец игры }
+      GameOver := true;
+      Form1.Status.Caption := 'Победа!'
+    end;
+    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 < FieldWidth) and (j < FieldHeight) 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
+  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 FieldWidth - 1 do
+    for j := 0 to FieldHeight - 1 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;
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Randomize;
+  { При запуске программы создаем кнопки }
+  MakeButtons;
+  StartGame;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  StartGame;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+var
+  i, j: Integer;
+begin
+  for i := 0 to FieldWidth - 1 do
+    for j := 0 to FieldHeight - 1 do
+      Field[i, j].Free;
+end;
+
+procedure MakeButtons;
+var
+  i, j: Integer;
+begin
+  for i := 0 to FieldWidth - 1 do
+    for j := 0 to FieldHeight - 1 do
+    begin
+      Field[i, j] := MySpeedButton.Create(nil); { Создать кнопку }
+      with Field[i, j] do
+      begin
+        { Указываем координаты кнопки }
+        Left := i * 24;
+        Top := j * 24;
+        { Указываем размеры кнопки }
+        Width := 24;
+        Height := 24;
+        Parent := Form1; { а также родительскую форму }
+        { x, y - Позиция кнопки на игровом поле }
+        x := i;
+        y := j
+      end
+    end;
+end;
+
+end.
+