Разработка игры «Крестики-нолики» в программе MS Excel с использованием VBA
Даже если из приложений у вас на компьютере есть только Microsoft Office, вам есть заняться. Приложения из этого семейства достаточно мощны для реализации логических игр.
Я уже писал, как разработать игру «Пятнашки», сейчас разработаем игру крестики-нолики.
Не будем задействовать графические возможности формы и сделаем поле с ячейками прямо на рабочем листе.
Выделим диапазон B3:D5, настроим границы, присвоим имя fld (меню Формулы->Присвоить имя). Это и будет поле.Я уже писал, как разработать игру «Пятнашки», сейчас разработаем игру крестики-нолики.
Не будем задействовать графические возможности формы и сделаем поле с ячейками прямо на рабочем листе.
Кроме поля нам понадобится кнопка, запускающая новую игру, и две пары переключателей. Одна пара будет переключать право первого хода (игрок или компьютер), вторая пара – кто чем играет (крестиками или ноликами).
Кнопке присваиваем макрос NewGame и создаем его. Чтобы добавить на рабочий лист элементы управления, нужно перейти на вкладку Разработчик и в разделе Элементы управления нажать кнопку Вставить, затем выбрать нужный элемент. Редактирование проводится в режиме конструктора. Чтобы отредактировать элемент, нажмите на него правой кнопкой мыши. Измените стандартные надписи и размер.
Каждая пара переключателей должна быть заключена в отдельную группу (элемент Группа).
Каждому переключателю создаем и присваиваем макрос. Для группы первого хода это будут макросы rbTurnGamer_Click() и rbTurnComp_Click(), для группы выбора символа: rbPictX_Click() и rbPict0_Click().
У нас получается вот такая картинка:
Перейдем к коду.
Редактор Visual Basic открывается сочетанием клавиш Alt+F11 или через меню Разработчик, или нажатием правой кнопки мыши на ярлычке листа внизу и выборе пункта «Исходный текст».
Создадим модуль, если до сих пор он не создан. Вообще-то Excel сам должен был создать модуль Module1, когда создавал макросы.
Создадим модуль, если до сих пор он не создан. Вообще-то Excel сам должен был создать модуль Module1, когда создавал макросы.
Код разделим на три части, одна часть будет отвечать за вывод на экран, вторая за взаимодействие с игроком, в третьей реализована логика игры. Если нужно будет перенести графику игры на форму, то потребуется изменить только вывод на экран и отслеживание действий пользователя.
Данные будем хранить в двухмерном массиве 3 на 3. Элементы массива могут быть пробелом, крестиком (буква х) или ноликом (цифра 0).
Объявляем общие для модуля переменные:
Public turn As Boolean - право первого хода, если false, то первым ходит компьютер
Public pictGamer As String – символ игрока
Public pictComp As String – символ компьютера
Public pictEmpty As String – пустая ячейка (свободная)
Public gameStatus As Boolean – статус игры (false – игра продолжается, true – закончена)
Dim arcells(1 To 3, 1 To 3) As String – массив ячеек.
Поскольку у нас нет таймера, то ходить компьютер будет только после хода игрока. Исключение составляет только случай, когда новая игра и право первого хода у компьютера. Тогда мы ставим значок компьютера в середину поля (ячейку во 2 строке и 2 столбце), чтобы получить максимальный контроль над полем.
Вот для того определить, кто ходит первым, нам и нужна переменная turn.
Статус игры нужен для того, чтобы не поставить крестик или нолик после того, как игра закончилась.
Вывод поля на экран осуществляет процедура ShowField:
'вывод на экран поля
Public Sub ShowField()
Dim i As Integer, j As Integer
For i = 1 To 3
For j = 1 To 3
Range("fld").Cells(i, j) = arcells(i, j)
Next j
Next i
End Sub
После каждого хода будем ее вызывать.
Игра будет запускать при открытии книги Excel:
Игра будет запускать при открытии книги Excel:
Private Sub Workbook_Open()
turn = True
pictGamer = "x"
pictComp = "0"
NewGame
End Sub
Устанавливаем, что первым ходит игрок, крестиками играет игрок, а ноликами - компьютер.
Процедура, запускающая новую игру:
Процедура, запускающая новую игру:
Public Sub NewGame()
Dim i As Integer, j As Integer
gameStatus = False
pictEmpty = " "
For i = 1 To 3
For j = 1 To 3
arcells(i, j) = pictEmpty
Next j
Next i
ShowField
If turn = False Then
arcells(2, 2) = pictComp
End If
ShowField
End Sub
Делаем все ячейки массива пустыми и выводим его на экран. Если первым ходит компьютер, то выводим его значок в середину поля.
Пользователь может выбрать, чем ему играть и кому первому ходить. Нажимая на переключатели, он запускает макросы:
Право первого хода у игрока
Пользователь может выбрать, чем ему играть и кому первому ходить. Нажимая на переключатели, он запускает макросы:
Право первого хода у игрока
Sub rbTurnGamer_Click()
turn = True
NewGame
End Sub
Право первого хода у компьютера
Sub rbTurnComp_Click()
turn = False
NewGame
End Sub
Пользователь играет крестиками
Sub rbPictX_Click()
pictGamer = "x"
pictComp = "0"
NewGame
End Sub
Пользователь играет ноликами
Sub rbPict0_Click()
pictGamer = "0"
pictComp = "x"
NewGame
End Sub
Заметьте, что при каждом переключении запускаем новую игру.
Логика игры
Должны быть процедуры хода игрока и компьютера. После каждого хода проведем проверку на окончание игры (функция WinCheck, возвращающая значок победителя, ничью или продолжение игры). Если кто-то выиграл или ничья, вызываем процедуру конца игры EndGame, выдающую сообщение об окончании игры и устанавливающую статус игры как игра окончена. Если игра не окончена, ходим дальше.
Победа определяется, если полностью закрыта какая-либо строка, столбец или диагональ поля одинаковыми значками (крестиками или ноликами). Ничья, если ни одна строка, столбец или диагональ не заполнена одинаковыми значками, но свободных ячеек больше не осталось. Продолжение игры, если свободные ячейки еще есть.
Public Function WinCheck() As String
Dim i As Integer
Dim j As Integer
‘проверка строк
If (arcells(1, 1) = arcells(1, 2)) And (arcells(1, 2) = arcells(1, 3)) Then
WinCheck = arcells(1, 1)
Exit Function
End If
If (arcells(2, 1) = arcells(2, 2)) And (arcells(2, 2) = arcells(2, 3)) Then
WinCheck = arcells(2, 1)
Exit Function
End If
If (arcells(3, 1) = arcells(3, 2)) And (arcells(3, 2) = arcells(3, 3)) Then
WinCheck = arcells(3, 1)
Exit Function
End If
‘проверка столбцов
If (arcells(1, 1) = arcells(2, 1)) And (arcells(2, 1) = arcells(3, 1)) Then
WinCheck = arcells(1, 1)
Exit Function
End If
If (arcells(1, 2) = arcells(2, 2)) And (arcells(2, 2) = arcells(3, 2)) Then
WinCheck = arcells(1, 2)
Exit Function
End If
If (arcells(1, 3) = arcells(2, 3)) And (arcells(2, 3) = arcells(3, 3)) Then
WinCheck = arcells(1, 3)
Exit Function
End If
‘проверка диагоналей
If (arcells(1, 1) = arcells(2, 2)) And (arcells(2, 2) = arcells(3, 3)) Then
WinCheck = arcells(1, 1)
Exit Function
End If
If (arcells(1, 3) = arcells(2, 2)) And (arcells(2, 2) = arcells(3, 1)) Then
WinCheck = arcells(1, 3)
Exit Function
End If
‘поиск свободных ячеек
For i = 1 To 3
For j = 1 To 3
‘есть свободные ячейки – продолжаем игру
If arcells(i, j) = pictEmpty Then
WinCheck = pictEmpty
Exit Function
End If
Next j
Next i
‘нет свободных ячеек, ничья
WinCheck = "draw"
End Function
Функция конца игры:
Public Sub EndGame(pict As String)
If pict = pictGamer Then
MsgBox "Вы победили!"
ElseIf pict = pictComp Then
MsgBox "Победил компьютер!"
ElseIf pict = "draw" Then
MsgBox "Игра закончена. Ничья!"
End If
gameStatus = True
End Sub
Ход компьютера
Компьютер должен определить, куда поставить свой значок. Для этого проводится проверка критической ситуации – если какая-то строка, столбец или диагональ уже содержит два его значка и одну пустую ячейку. Поставив в пустую ячейку свой значок, компьютер выиграет.
Если такого положения нет, то компьютер проверяет такую же ситуацию, но со стороны игрока. В этом случае ему нужно поставить свой значок в ячейку, чтобы не дать игроку занять всю линию.
Если такого положения нет, то компьютер проверяет такую же ситуацию, но со стороны игрока. В этом случае ему нужно поставить свой значок в ячейку, чтобы не дать игроку занять всю линию.
Создадим процедуру проверки такой ситуации. Она будет принимать в качестве аргументов значок (крестик или нолик), номер строки и номер столбца. Номера строки и столбца передаем по ссылке. Если обнаружена критическая ситуация, то в процедуре они изменится на номера строки и столбца, куда нужно поставить значок.
Public Sub Varning(pict As String, ByRef r As Integer, ByRef c As Integer)
Dim i As Integer
'Проверка по строкам
For i = 1 To 3
If (arcells(i, 1) = pict) And (arcells(i, 2) = pict) And (arcells(i, 3) = pictEmpty) Then
r = i
c = 3
Exit Sub
ElseIf (arcells(i, 1) = pict) And (arcells(i, 2) = pictEmpty) And (arcells(i, 3) = pict) Then
r = i
c = 2
Exit Sub
ElseIf (arcells(i, 1) = pictEmpty) And (arcells(i, 2) = pict) And (arcells(i, 3) = pict) Then
r = i
c = 1
Exit Sub
End If
Next i
'проверка по столбцам
For i = 1 To 3
If (arcells(1, i) = pict) And (arcells(2, i) = pict) And (arcells(3, i) = pictEmpty) Then
r = 3
c = i
Exit Sub
ElseIf (arcells(1, i) = pict) And (arcells(2, i) = pictEmpty) And (arcells(3, i) = pict) Then
r = 2
c = i
Exit Sub
ElseIf (arcells(1, i) = pictEmpty) And (arcells(2, i) = pict) And (arcells(3, i) = pict) Then
r = 1
c = i
Exit Sub
End If
Next i
'проверка диагоналей
If (arcells(1, 1) = pictEmpty) And (arcells(2, 2) = pict) And (arcells(3, 3) = pict) Then
r = 1
c = 1
Exit Sub
End If
If (arcells(1, 1) = pict) And (arcells(2, 2) = pictEmpty) And (arcells(3, 3) = pict) Then
r = 2
c = 2
Exit Sub
End If
If (arcells(1, 1) = pict) And (arcells(2, 2) = pict) And (arcells(3, 3) = pictEmpty) Then
r = 3
c = 3
Exit Sub
End If
If (arcells(1, 3) = pictEmpty) And (arcells(2, 2) = pict) And (arcells(3, 1) = pict) Then
r = 1
c = 3
Exit Sub
End If
If (arcells(1, 3) = pict) And (arcells(2, 2) = pictEmpty) And (arcells(3, 1) = pict) Then
r = 2
c = 2
Exit Sub
End If
If (arcells(1, 3) = pict) And (arcells(2, 2) = pict) And (arcells(3, 1) = pictEmpty) Then
r = 3
c = 1
Exit Sub
End If
End Sub
Если же критической ситуации нет, то проверяем среднюю ячейку (контроль 4 линий), затем угловые (контроль трех линий). Если все они заняты, то ставим значок в любую пустую ячейку.
Функция хода компьютера:
Функция хода компьютера:
Public Sub CompTurn()
Dim r As Integer
Dim c As Integer
'игра закончена, выход из процедуры
If gameStatus = True Then
Exit Sub
End If
r = -1
c = -1
'проверяем на заполненность линий значками компютера
Varning pictComp, r, c
If (r <> -1) And (c <> -1) Then
arcells(r, c) = pictComp
Exit Sub
End If
'проверяем на заполненность линий значками игрока
Varning pictGamer, r, c
If (r <> -1) And (c <> -1) Then
arcells(r, c) = pictComp
Exit Sub
End If
'если средняя ячейка рустая, то ставим в нее
If arcells(2, 2) = pictEmpty Then
arcells(2, 2) = pictComp
Exit Sub
End If
'ищем свободную угловую ячейку
For r = 1 To 3 Step 2
For c = 1 To 3 Step 2
If arcells(r, c) = pictEmpty Then
arcells(r, c) = pictComp
Exit Sub
End If
Next c
Next r
'ищем любую свободную ячейку
For r = 1 To 3
For c = 1 To 3
If arcells(r, c) = pictEmpty Then
arcells(r, c) = pictComp
Exit Sub
End If
Next c
Next r
End Sub
Ход игрока
Осталось рассмотреть только ход игрока. Создадим процедуру GamerTurn, которая принимает номер столбца и номер строки ячейки, на которую нажал игрок. Что нужно сделать в этой процедуре.
Во-первых, определить, не окончена ли игра. Если окончена, то выйти из процедуры.
Во-вторых, изменить массив ячеек и вывести его на экран.
В-третьих, проверить на окончание игры. Если функция проверки на окончание возвращает значок победителя или ничью, то вызвать функцию окончания игры. Если игра не окончена, то выполнить ход компьютера, вывести поле на экран. Затем снова проверить на окончание игры.
Во-первых, определить, не окончена ли игра. Если окончена, то выйти из процедуры.
Во-вторых, изменить массив ячеек и вывести его на экран.
В-третьих, проверить на окончание игры. Если функция проверки на окончание возвращает значок победителя или ничью, то вызвать функцию окончания игры. Если игра не окончена, то выполнить ход компьютера, вывести поле на экран. Затем снова проверить на окончание игры.
Public Sub GamerTurn(r As Integer, c As Integer)
If gameStatus = True Then
Exit Sub
End If
arcells(r, c) = pictGamer
ShowField
If WinCheck() <> pictEmpty Then
'игра окончена
EndGame WinCheck
gameStatus = True
'игра не окончена, ходит компьютер
Else
CompTurn
ShowField
If WinCheck() <> pictEmpty Then
'игра окончена
EndGame WinCheck
gameStatus = True
End If
End If
End Sub
Для хода пользователь должен нажать правую кнопку мыши на поле fld. Если он нажмет, вне поля, то никаких действий выполняться не будет (кроме контекстного меню). Если нажмет в поле, и при этом ячейка свободна, то вызываем процедуру хода игрока и передаем туда номер строки и столбца нажатой ячейки. При этом пересчитываем их в номера строк и столбцов массива, поскольку отсчет строк и столбцов листа и именованного диапазона отличаются. Затем отказываемся от стандартных действий Excel – контекстного меню (Cancel = true).
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Integer
Dim c As Integer
r = ActiveCell.Row
c = ActiveCell.Column
If (r > 2) And (r < 6) And (c > 1) And (c < 5) Then
If ActiveCell.Value = pictEmpty Then
GamerTurn r - 2, c - 1
End If
Cancel = True
End If
End Sub
Пример окончания игры:
Возможно, еще имеет смысл проводить инициализацию пустых переменных значков компьютера и игрока в процедуре NewGame, поскольку сейчас это делается только в процедуре открытия книги и клике на переключателях. Если эти значения теряются, то приходится кликать на переключатели. Ну это по желанию.
Файл с этим вариантом игры выложен в паблике ВК
Файл с этим вариантом игры выложен в паблике ВК