Yandex.Метрика

Сапер на VBA

Однажды, мне захотелось попробовать сделать элементарную игру «Сапер» в Excel на VBA.

Для тех, кто не знает, расскажу правила игры: есть квадратное поле, которое состоит из ячеек, например 20х20. В этих ячейках расположено определенное количество мин (пусть будет 40). Все ячейки скрыты и игрок не знает, где эти мины спрятаны. Игрок пошагово открывает ячейку за ячейкой, пытаясь не попасть на мину. Когда игрок нажимает на пустую ячейку, она открывается и открывается некоторая область пустых ячеек вокруг нее. Данная пустая область ограничена ячейками, в которой содержатся цифры — цифра в ячейке показывает сколько мин расположено вокруг нее:

Сапер

Игра завершается тогда, когда открыты все ячейки, кроме тех, в которых содержатся мины — то есть в нашем случае (20х20-40) = 360 ячеек.

Для реализации этой задумки сначала был составлен алгоритм:

  1. Создать поле из ячеек
  2. Расположить мины на поле
  3. Расположить цифры на поле, показывающее количество мин вокруг
  4. Скрыть все поле другими цветами
  5. Создать события по нажатию на ячейку: если пустая, с цифрой, с миной

Также был составлен список проблем или недоработок, которые были найдены уже после написания кода:

  • Установка флажка на ячейку, по нажатию правой кнопки отсутствует (некоторые люди ставят флажки на тех местах, где по их мнению может быть мина, но они не уверены на 100%).
  • В оригинальной игре «Сапер» на Windows, при первом открытии ячейки нельзя попасть на мину: сначала игрок нажимает на ячейку, а затем генерируется поле, где нажатая ячейка НЕ является миной, а потом уже идет полноценная игра. На момент написания кода я этого не учел, поэтому с некоторой вероятностью первым кликом можно попасть на мину. Пока писал данный пункт — понял, как это реализовать, но решил, что переделывать уже не буду.
  • Нет уведомлении об успешном «разминировании» всего поля. Добавлю это спустя некоторое время: в теории это не очень сложно, но, вероятно, это немного замедлит скорость выполнения всех макросов.
  • Также в оригинальной игре есть возможность открыть все скрытые ячейки вокруг цифры, при условии, что все мины вокруг нее уже открыты — нужно было нажать на цифру левой кнопкой при зажатой правой. Функция довольно полезная, но на VBA реализовать ее мне не удалось.

Итак, «Сапер»:

Наш первый пункт — создать поле из ячеек. В Excel с этим не может возникнуть никаких проблем, ведь лист Excel по своей сути и есть набор ячеек. Единственное, что нам нужно сделать — определиться, какого размера будет наш «игровой квадрат», нарисовать границы и сделать ширину ячеек равной ее высоте. В конечном итоге, наше поле будет выглядеть так (поле 20х20):

Поле игры Сапер в Excel

Пункт второй: необходимо в нашей игре «Сапер» расположить на поле все мины.  С этим пунктом также не должно возникнуть никаких проблем — все просто и элементарно. Нужно в случайных местах нашего поля расставить необходимое нам количество мин. Для этого пишем нужный нам код:

Sub mines()
Dim mines_count As Integer
mines_count = 0
Do While (mines_count <= 40) 'наше количество мин
    Randomize
    i = Int((20 * Rnd) + 2) 'рандомное определение строки для мины
    j = Int((20 * Rnd) + 2) 'рандомное определение столбца для мины
    If Sheets("Game").Cells(i, j) = "" Then 'если в ячейке ничего нет
        Sheets("Game").Cells(i, j) = "Б" '"ставим" в эту ячейку Бомбу
        Sheets("Game").Cells(i, j).Font.Bold = True 'и устанавливаем жирный шрифт для бомбы
        mines_count = mines_count + 1 'увеличиваем счетчик бомб на 1
    End If
Loop 'следующая итерация цикла
End Sub

В данном макросе мы заполняем поле минами через цикл «While» (пока выполняется условие) — он работает до тех пор, пока на нашем поле не будет нужного нам количества мин (в данном примере — 40). Мы «рандомно» определяем строку, в которой будет находиться мина, затем так же «рандомно» определяем столбец для мины. Если в ячейке ничего нет — заполняем ее буквой «Б» (это означает, что там бомба, то есть мина) и увеличиваем счетчик мин на 1. Если в данном месте уже есть мина — ничего не делаем. И когда счетчик мин будет равен 40 — выполнение макроса завершится:

Мины в игре Сапер в Excel

Пункт третий: необходимо в ячейках разместить цифры, которые будут показывать количество мин вокруг. Ниже представлен код для выполнения данного пункта:

Sub mines_count()
For i = 2 To 21 'запускаем цикл по каждой ячейки нашего минного поля
For j = 2 To 21 'столбцы и строки
    Count = 0 'счетчик мин равный нулю
    If (Sheets("Game").Cells(i, j) = "") Then 'проверяем ячейки вокруг искомой
        For x = i - 1 To i + 1
        For y = j - 1 To j + 1
            'если вокруг искомой ячейки есть мина - наращиваем счетчик 
            If ((Sheets("Game").Cells(x, y) = "Б") And (x <> 0) And (y <> 0)) Then Count = Count + 1:
        Next y
        Next x
    If Count <> 0 Then Sheets("Game").Cells(i, j) = Count 'если счетчик не равен нулю - ставим цифру в ячейку
    End If
Next j
Next i
End Sub

В этом макросе мы проверяем каждую ячейку нашего минного поля, перебирая двумя циклами строки и столбцы. Мы считаем, сколько мин вокруг ячейки и вписываем в нее их количество. Если же мин вокруг ячейки нет — оставляем ее пустой.

Расстановка цифр в игре Сапер в Excel

Пункт четвертый: скрыть все мины и цифры. Это максимально просто: закрашиваем весь фон игрового диапазона новым цветом и точно таким же цветом окрашиваем шрифт мин и цифр, тем самым маскируя все поле:

Sub painting()
Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Interior.Color = RGB(231, 230, 230) 'заливка фона
Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Font.Color = RGB(231, 230, 230) 'изменение цвета шрифта
End Sub

Скрытое поле игры Сапер

Все, поле игры «Сапер» на листе Excel готово. Теперь приступаем к самому главному!

Пункт пятый: события по нажатию на ячейку. Возможно, для кого-то данный пункт покажется сложным для восприятия, но я постараюсь рассказать все максимально просто.

Для его реализации составим подробный алгоритм:

  1. Отследить «выделение ячейки» и запустить определенный код в зависимости от ее содержимого
  2. Если ячейка равна «Б» — вывести сообщение о проигрыше и открыть все поле
  3. Если ячейка равна цифре — отобразить данную цифру, изменив ее цвет на черный
  4. Если ячейка пустая — запустить код по открытию прилежащей пустой области, ограниченной цифрами с количеством мин
  5. Если ячейка не относится к игровому полю — не делать ничего

Подробно разберем каждый из этих пунктов.

Сначала — отслеживание «выделения ячейки» . Отслеживать выделение ячейки в Excel можно с помощью стандартного события «Worksheet_SelectionChange«. Код для данного события вписывается в нужный нам лист и выполняется каждый раз когда мы будем выделять какую-нибудь ячейку на этом листе:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub 'если выделено несколько ячеек - игнорируем
'если выделенная ячейка принадлежит игровому полю игры Сапер - запускаем обработку
If Not Application.Intersect(Range(Cells(2, 2), Cells(21, 21)), Target) Is Nothing Then
    table_click (Target) 'запуск макроса обработки
End If
End Sub

В данном коде есть две проверки.

  • Первая — количество выделенных ячеек. По правилам игры, мы должны щелкнуть на одну ячейку, потом на другую, третью и так далее. Мы не можем нажать сразу на несколько. Поэтому и в Excel, чтобы «случайно» не нажать на несколько ячеек, т.е. в нашем случае, чтобы случайно их не выделить — добавляем ограничение: если количество выделенных ячеек больше 1 — ничего не выполняем, выходим из процедуры.
  • Вторая — проверяем принадлежность выделенной ячейки нашему игровому полю. Если ячейка не имеет никакого отношения к нему — не делаем ничего, в противном случае запускаем обработку ячейки с помощью макроса table_click (target), где target — наша выделенная ячейка. Код макроса table_click:
Sub table_click(a)
If (a = "Б") Then 'если ячейка содержит "Б" - игра проиграна
    Selection.Interior.Color = RGB(255, 255, 255) 'фон выделенной ячейки становится белым
    Selection.Font.Color = RGB(0, 0, 0) 'цвет шрифта бомбы - черным
    MsgBox "Подрыв! Игра окончена!", vbCritical + vbOKOnly, "Booooom!" 'выводим сообщение Boom
    Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Interior.Color = RGB(255, 255, 255) 'а затем все поле делаем белым
    Sheets("Game").Range(Cells(2, 2), Cells(21, 21)).Font.Color = RGB(0, 0, 0) 'и цвет шрифта на всем поле - черным (чтобы видеть всю картину)
End If
If (a >= 1) Then 'если выделенная ячейка содержит цифру
    Selection.Interior.Color = RGB(255, 255, 255) 'меняем цвет шрифт выделенной ячейки на черный
    Selection.Font.Color = RGB(0, 0, 0) 'а фон выделенной ячейки на белый
End If
If (a = "") Then
    prepare 'включение кода оптимизации
    free_space Selection.Row, Selection.Column 'запуск рекурсии начиная с выделенной ячейки (где Selection.Row - ее строка, Selection.Column - столбец)
    white 'раскрытие ячеек с цифрами вокруг открытой пустой области
    ended 'выключение кода оптимизации
End If
End Sub

Если содержимое ячейки равно «Б» — фон ячейки становится белым, шрифт черным. Выводим сообщение о проигрыше и фон всего поля окрашиваем белым (то есть все поле открывается).

Если содержимое равно 1 или больше — фон ячейки также становится белым, а шрифт черным, то есть мы просто «открываем» ячейку с миной.

Если содержимое ячейки равно «»,  то есть в ней нет ничего, запускаем целый набор макросов:

Включение кода оптимизации — данный код взят отсюда. При запуске деактивируются некоторые опции Excel, которые негативно влияют на быстродействие.

Public Sub Prepare()
    Application.ScreenUpdating = False 'отключение обновления экрана
    Application.Calculation = xlCalculationManual 'отключение автоматического пересчета формул
    Application.EnableEvents = False 'отключение обработки событий
    ActiveSheet.DisplayPageBreaks = False 'отключить отображение разрывов страниц
    Application.DisplayStatusBar = False 'отключить статусную строку в Excel
    Application.DisplayAlerts = False 'отключить отображение ошибок и предупреждений
End Sub

Успешно используется мной во всех проектах и значительно сокращает время работы макросов при работе с большими объемами данных — рекомендую использовать данный код почаще, но старайтесь не забывать его «деактивировать».

Запуск рекурсии по раскрытию пустых ячеек вокруг. Рекурсия — это такое явление в программировании, когда функция/макрос/процедура запускает сама себя. И запускать себя она будет до тех пор, пока не встретится ограничивающее условие (в противном случае она может зациклиться и не закончиться никогда).

Смысл данной рекурсии заключается вот в чем: есть пустая ячейка на которую мы нажали. Запускается макрос, которые проверяет на «пустоты» соседние ячейки относительно выбранной. Макрос находит такую пустую ячейку, окрашивает ее в белый цвет и запускает сам себя же, только теперь уже относительно этой пустой ячейки. И выполняться он будет до тех пор, пока либо не упрется в границы игрового поля, либо если вокруг пустой ячейки не останется других пустых.

Sub free_space(n, m)
On Error GoTo new_recur 'при ошибке запускается заново. Не знаю, как это работает, но ошибка при повторном запуске пропадает
For i = n - 1 To n + 1 
    For j = m - 1 To m + 1
        If (Cells(i, j) = "") And (Cells(i, j).Interior.Color = RGB(231, 230, 230)) Then 'если ячейка пустая и закрашенная (то есть принадлежит игровому полю)
            Cells(i, j).Interior.Color = RGB(255, 255, 255) 'обесцвечиваем ее 
            free_space i, j 'и запускаем этот же макрос относительно нее
        End If
    Next j
Next i
GoTo continue
new_recur:
    free_space n, m
continue:
End Sub

И если мы нажали на пустую ячейку — после выполнения данного макроса откроется вся пустая область вокруг нее.

Отображение цифр с количеством мин. Естественно, вокруг открытой области надо отобразить цифры, которые «формируют» эту область, чтобы можно было дальше играть. Для этого мы запускаем макрос white, суть которого проста: перебираем все ячейки нашего игрового поля и, если ячейка пустая и уже открытая — открываем ячейки вокруг нее, изменяя цвет фона на белый, а цвет шрифта в ячейке на черный.

Sub white()
For i = 2 To 21
For j = 2 To 21
    If (Cells(i, j).Interior.Color = RGB(255, 255, 255)) And (Cells(i, j).Value = "") Then
        For x = i - 1 To i + 1
        For y = j - 1 To j + 1
            Cells(x, y).Interior.Color = RGB(255, 255, 255)
            Cells(x, y).Font.Color = RGB(0, 0, 0)
        Next y
        Next x
    End If
Next j
Next i
End Sub

Выключение кода оптимизации. Активируем опции Excel, которые мы выключили перед выполнением предыдущих макросов:

Public Sub ended()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    'ActiveSheet.DisplayPageBreaks = True 'Разрывы страниц для печати можно не возвращать - они тормозят работу в любом случае и не особо нужны
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub

В целом, работа по созданию игры «Сапер» завершена!


В моем примере также добавлена кнопка, которая запускает макрос full_game(), который полностью формирует поле для игры — ставит мины и цифры и закрашивает их шрифт и фон одинаковыми цветами. Также в ней запускается вышеупомянутый макрос оптимизации, для сокращения времени работы макросов.

Sub full_game()
    prepare 'включение кода оптимизации
    clearing_table 'очистка поля
    mines 'расстановка мин
    mines_count 'количество мин вокруг
    painting 'заливка
    ended 'отключение кода оптимизации
End Sub

При добавлении каких-либо доработок типа «исключение взрыва при открытии первой ячейки» или «уведомление о победе» будет сообщено дополнительно.

Скачать готовый файл можно нажав сюда.

2 комментария

  1. Евгений 27.08.2019
    • HeinzBr 27.08.2019

Reply Cancel Reply