From e87eaf26d5a3f17110c3a9c5d8b425eb6a9a5f49 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 11 Mar 2026 14:44:08 +0100 Subject: =?UTF-8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=B8=D0=BB=20=D1=81?= =?UTF-8?q?=D0=B0=D0=BF=D0=B5=D1=80=D0=B0=20=D0=B8=D0=B7=20=D1=81=D0=B5?= =?UTF-8?q?=D0=B4=D1=8C=D0=BC=D0=BE=D0=B9=20=D0=B3=D0=BB=D0=B0=D0=B2=D1=8B?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/1_minesweeper/unit1.pas" | 248 +++++++++++++++++++++ 1 file changed, 248 insertions(+) create mode 100644 "\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/1_minesweeper/unit1.pas" (limited to 'Занимательное программирование/7/1_minesweeper/unit1.pas') diff --git "a/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/1_minesweeper/unit1.pas" "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/1_minesweeper/unit1.pas" new file mode 100644 index 0000000..d20aa7a --- /dev/null +++ "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/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. + -- cgit v1.2.3