Studhelper IT: Игра Сапер VBA

Разработка игры «Сапер» в программе Microsoft Excel с использованием языка VBA

Игра будет похожа на свой аналог из Windows.
Состояние поля (мины, флаги, открытые клетки, количество мин в соседних клетках) будем хранить в одном массиве fld. Вывод массива на экран будет осуществлять отдельная функция. То есть у нас получается отдельно логика игры и интерфейс. Еще нужно организовать взаимодействие с пользователем.

Поскольку работать будем не с формой, а с рабочим листом Excel, то выбор функций невелик. Кликом правой кнопки мыши будем ставить флаг, а двойным кликом левой кнопки будем открывать ячейку. Получается слегка непривычно после стандартной игры.

На рабочем листе выделяем диапазон 10 на 10 ячеек. Устанавливаем нужную ширину и высоту ячеек, границы. Присвоим имя этому диапазону, допустим fld. Вместо флага будем ставить букву F и закрашивать ячейку в зеленый цвет. Мину будет обозначать буква М и красный цвет ячейки. Ячейка с миной, на которой игрок подрывается, будет закрашена в более яркий цвет, чем другие мины. Общий вид игрового поля:

Переходим в редактор Visual Basic (Alt+F11) и создаем новый модуль. Назовем его saper.
Вот такие переменные нам нужны:
Public cntRow As Byte – количество строк поля
Public cntColumn As Byte – количество столбцов поля
Public cntMina As Byte – количество мин на поле
Public cntFoundMina As Byte – количество найденных мин
Public cntFlag As Byte – количество поставленных флагов
Public gameStatus As Byte – статус игры (0 – начало, 1 – игра, 2 – игра закончена).
Dim fld(1 To 12, 1 To 12) As Integer – массив, который содержит все клетки поля, включая границы.

Возможные значения элементов массива fld:

0..8 – количество мин во всех соседних клетках;
9 – в данной клетке мина;
100..109 – клетка открыта;
200..209 – в клетку поставлен флаг.

Нам нужны функции: новая игра, вывод поля на экран, установка флага, открытие незанятых минами ячеек (рекурсивная), открытие одной ячейки. И еще обработка нажатий клавиш мыши.

Функция Новая игра (NewGame)

Сначала инициализируем общие переменные. Затем присваиваем всем элементам массива значение -1. Затем элементам поля внутри границ (10 на 10) присваиваем значения 0. То есть мин пока на поле нет. Затем случайным образом (с помощью функции rnd) устанавливаем мины в ячейки. Продолжаем, пока количество установленных мин не будет равно нужному количеству.

После установки мин перебираем все элементы массива. Если в текущей ячейке нет мины, то считаем окружающие мины и записываем их число. Найденных мин и установленных флагов в начале игры нет, обнуляем эти значения. В завершение выводим массив на экран.

Public Sub NewGame()
Dim row, col As Byte
Dim n As Byte 'количество мин
Randomize
    cntRow = 10
    cntColumn = 10
    cntMina = 10
    gameStatus = 0
    For row = 1 To cntRow + 2
        For col = 1 To cntColumn + 2
            fld(row, col) = -1
        Next col
    Next row
    For row = 2 To cntRow + 1
        For col = 2 To cntColumn + 1
            fld(row, col) = 0
        Next col
    Next row
    n = 0
    Do
        row = Int(cntRow * Rnd + 2)
        col = Int(cntColumn * Rnd + 2)
        If fld(row, col) <> 9 Then
           fld(row, col) = 9
           n = n + 1
        End If
    Loop While n <> cntMina

    For row = 2 To cntRow + 1
        For col = 2 To cntColumn + 1
            If fld(row, col) <> 9 Then
                n = 0
                If fld(row - 1, col - 1) = 9 Then n = n + 1
                If fld(row - 1, col) = 9 Then n = n + 1
                If fld(row - 1, col + 1) = 9 Then n = n + 1
                If fld(row, col - 1) = 9 Then n = n + 1
                If fld(row, col + 1) = 9 Then n = n + 1
                If fld(row + 1, col - 1) = 9 Then n = n + 1
                If fld(row + 1, col) = 9 Then n = n + 1
                If fld(row + 1, col + 1) = 9 Then n = n + 1
                fld(row, col) = n
            End If
        Next col
    Next row
    cntFoundMina = 0
    cntFlag = 0
    showFld
End Sub

Функция вывода на экран.

В начале игры (статус игры – 0) выводим все ячейки, как закрытые, то есть значения равны «», цвет шрифта – черный, цвет ячейки – серый. Если статус игры 1 или 2, то выводим массив в зависимости от содержимого. Смотрим комментарии в тексте функции.

Public Sub showFld()
Dim row, col As Byte

    If gameStatus = 0 Then
        For row = 1 To cntRow
            For col = 1 To cntColumn
                Range("fld").Cells(row, col) = ""
                Range("fld").Cells(row, col).Interior.Color = RGB(230, 230, 230)
                Range("fld").Cells(row, col).Font.Color = RGB(0, 0, 0)
            Next col
        Next row
        Exit Sub
    End If

    For row = 1 To cntRow
        For col = 1 To cntColumn
           ‘ячейка закрыта
              If fld(row + 1, col + 1) < 100 Then
                Range("fld").Cells(row, col) = ""
                Range("fld").Cells(row, col).Interior.Color = RGB(230, 230, 230)
            ‘в ячейке ненайденная мина и игра окончена
              If (gameStatus = 2) And (fld(row + 1, col + 1) = 9) Then
                    Range("fld").Cells(row, col) = "M"
                    Range("fld").Cells(row, col).Interior.Color = RGB(250, 150, 150)
               End If
            End If
           ‘мин нет, ячейка открыта. Окрашиваем в светлый цвет
If fld(row + 1, col + 1) = 100 Then
                    Range("fld").Cells(row, col) = ""
                    Range("fld").Cells(row, col).Interior.Color = RGB(250, 250, 250)
            End If
           ‘в соседних ячейках есть мины. В зависимости от их количества меняется цвет шрифта. Цвет ячейки светлый серый
            If (fld(row + 1, col + 1) >= 101) And (fld(row + 1, col + 1) <= 108) Then
                    Range("fld").Cells(row, col) = fld(row + 1, col + 1) - 100
                    Range("fld").Cells(row, col).Interior.Color = RGB(250, 250, 250)
                    Select Case fld(row + 1, col + 1)
                    Case 101
                        Range("fld").Cells(row, col).Font.Color = RGB(10, 10, 250)
                    Case 102
                        Range("fld").Cells(row, col).Font.Color = RGB(10, 250, 10)
                    Case Is > 102
                        Range("fld").Cells(row, col).Font.Color = RGB(250, 10, 10)
                    End Select
            End If
    ‘установлен флаг
            If fld(row + 1, col + 1) >= 200 Then
                    Range("fld").Cells(row, col) = "F"
                    Range("fld").Cells(row, col).Interior.Color = RGB(10, 200, 10)
            End If
    ‘игра окончена, показываем мины, найденные и нет
            If (gameStatus = 2) And (fld(row + 1, col + 1) Mod 10 = 9) Then
                    Range("fld").Cells(row, col) = "M"
                    Range("fld").Cells(row, col).Interior.Color = RGB(250, 150, 150)
            End If
    ‘на этой мине игрок подорвался. Делаем более красный цвет, чем обычная мина
            If fld(row + 1, col + 1) = 109 Then
                    Range("fld").Cells(row, col) = "M"
                    Range("fld").Cells(row, col).Interior.Color = RGB(250, 100, 100)
            End If
        Next col
    Next row
End Sub

Следующая процедура рекурсивно открывает текущую клетку и соседние пустые клетки

Public Sub openCell(row As Integer, col As Integer)
    If fld(row, col) = 0 Then
        fld(row, col) = 100
        openCell row, col - 1
        openCell row - 1, col
        openCell row, col + 1
        openCell row + 1, col

        openCell row - 1, col - 1
        openCell row - 1, col + 1
        openCell row + 1, col - 1
        openCell row + 1, col + 1
    Else
‘открываем клетку, если она не граничная, то есть не равна -1
        If (fld(row, col) < 100) And (fld(row, col) <> -1) Then
            fld(row, col) = fld(row, col) + 100
        End If
    End If
End Sub

Открываем одну клетку.

Если игра закончена, то сразу выходим из процедуры. Если жто начало игры, то устанавливаем статус, равный 1, то есть игра началась. Если в клетке мина, то подрываемся и заканчиваем игру. Если мины нет, то открываем соседние пустые клетки. Затем выводим поле на экран.

Public Sub open1cell(row As Integer, col As Integer)
    If gameStatus = 2 Then Exit Sub
    If gameStatus = 0 Then gameStatus = 1
    If fld(row, col) = 9 Then
        fld(row, col) = fld(row, col) + 100
        gameStatus = 2
        showFld
        MsgBox "Вы подорвались на мине! Игра закончена."
    ElseIf fld(row, col) < 9 Then
        openCell row, col
        showFld
    End If
End Sub

Установка флага

Если игра закончена, то сразу выходим из процедуры. Если жто начало игры, то устанавливаем статус, равный 1, то есть игра началась. Флаг устанавливаем только в открытые ячейки. Если в ячейке уже стоит флаг, то снимем его. При установке увеличиваем количество флагов, при снятии уменьшаем. Если в ячейке с устанавливаемым флагом на самом деле содержится мина, то увеличиваем счетчик найденных мин. И наоборот, счетчик уменьшаем, если флаг снят с ячейки с миной. И в конце сравниваем количество флагов, количество мин и количество найденных мин. Если они совпадают, то игрок выиграл и игра закончена.

Public Sub SetFlag(row As Integer, col As Integer)
    If gameStatus = 2 Then Exit Sub
    If gameStatus = 0 Then gameStatus = 1
‘клетка закрыта, ставим флаг
    If fld(row, col) <= 9 Then
        cntFlag = cntFlag + 1
‘в клетке мина
        If fld(row, col) = 9 Then cntFoundMina = cntFoundMina + 1
        fld(row, col) = fld(row, col) + 200
   ‘в клетку уже стоит флаг, снимем его
ElseIf fld(row, col) >= 200 Then
        cntFlag = cntFlag - 1
        fld(row, col) = fld(row, col) – 200
‘в клетке мина
        If fld(row, col) = 9 Then cntFoundMina = cntFoundMina - 1
    End If
‘все флаги установлены на всех минных ячейках
    If (cntMina = cntFoundMina) And (cntFlag = cntMina) Then
        gameStatus = 2
        MsgBox "Все мины найдены! Игра закончена."
    End If
    showFld
End Sub

При открытии книги запустим новую игру:

Private Sub Workbook_Open()
NewGame
End Sub

Обработка двойного клика левой кнопки (открываем клетку)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim row As Integer
Dim col As Integer
    row = ActiveCell.row
    col = ActiveCell.column
‘нажатие вне поля игры, выходим
    If (row < 5) And (row > 14) Then Exit Sub
    If (col < 3) And (col > 12) Then Exit Sub
‘открываем клетку, передавая в нее координаты, пересчитанные в наш диапазон из координат на листе Excel
    open1cell row - 3, col – 1
‘отказ от стандартной обработки нажатия
    Cancel = True
End Sub

Обработка клика правой кнопкой мыши

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim row As Integer
Dim col As Integer
    row = ActiveCell.row
    col = ActiveCell.column
‘нажатие вне поля игры, выходим
    If (row < 5) And (row > 14) Then Exit Sub
    If (col < 3) And (col > 12) Then Exit Sub
‘вызываем процедуру установки флага в текущую ячейку, передавая ее координаты, пересчитанные в диапазон поля из диапазона листа
    SetFlag row - 3, col – 1
‘отказ от стандартной обработки нажатия
    Cancel = True
End Sub

Добавляем на лист кнопку (вкладка Разработчик), пишем текст «Новая игра», присваиваем ей макрос – процедуру NewGame из модуля saper.
Процесс игры

Попали на мину:

Можно еще доделать различные размеры поля, запись рекордов и так далее.

Studhelper IT

Страницы

четверг, 25 сентября 2014 г.

Игра Сапер VBA

Разработка игры «Сапер» в программе Microsoft Excel с использованием языка VBA

Функция Новая игра (NewGame)

Функция вывода на экран.

Открываем одну клетку.

Установка флага

Обработка двойного клика левой кнопки (открываем клетку)

Обработка клика правой кнопкой мыши

Страницы

четверг, 25 сентября 2014 г.

Игра Сапер VBA

Разработка игры «Сапер» в программе Microsoft Excel с использованием языка VBA

Функция Новая игра (NewGame)

Функция вывода на экран.

Открываем одну клетку.

Установка флага

Обработка двойного клика левой кнопки (открываем клетку)

Обработка клика правой кнопкой мыши

четверг, 25 сентября 2014 г.