Шаг 217.
VBA в MSExcel. Практические приемы программирования на VBA. Тема: игра в крестики и нолики. Практика

    На этом шаге мы рассмотрим основные моменты создания указанного приложения.

    В редакторе форм создадим диалоговое окно Крестики — нолики (рисунок 1).


Рис.1. Диалоговое окно Крестики — нолики в редакторе форм

    Поле игры будут образовывать девять элементов управления Caption (Надпись). Для видимости границ элементов управления Caption установите свойство BorderStyle равным fmBorderStyleSingle.

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

    Итак, в нашей игре первый ход за пользователем. Ход осуществляется двойным щелчком по игровому полю. Если игровое поле пусто, то в нем отображается крестик. Компьютер мгновенно отвечает на ход игрока, постановкой нолика в другое игровое поле и т. д. О результате игры компьютер информирует пользователя. При желании сыграть еще одну игру с компьютером, нажмите кнопку Переиграть, которая очистит игровые поля. На рисунке 2 приведен вид партии в Крестики — нолики после второго шага игры.


Рис.2. Пример партии игры в Крестики — нолики после второго шага игры

    Крестик и нолик, которые выводятся на игровом поле, содержатся в файлах cross.bmp и ou.bmp, а их образы можно создать при помощи любого графического редактора.

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

    Стратегия компьютера в игре Крестики — нолики очень проста:

    Обсудим, как приведенная ниже программа решает описанную задачу и что в ней происходит.

UserForm_Initialize
  1. Активизирует диалоговое окно.
  2. Очищает все надписи от рисунков и текста, обнуляет все переменные.

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

Нажатие кнопки Выход запускает на выполнение процедуру CommandButton2_Click
Закрывает диалоговое окно.

От процедуры Label1_DblClick до Label9_DblClick
При двойном щелчке в ячейке игрового поля ставит крестик при условии, что эта ячейка была ранее пустой. Проверяет, привел ли этот ход к победе игрока, если да, то выдается соответствующее сообщение и игра завершается.

    Если нет, то компьютер делает свой ответный ход. Проверяет, привел ли ход компьютера к его победе, если да, то выдается соответствующее сообщение (рисунок 1) и игра завершается.


Рис.3. Пример сообщения о результате игры

Strategy_1 и Strategy
Генерируют первый и последующие ходы соответственно.

Проверка
Проверяет, нет ли в игре победителей.

НачальноеСостояние
Очищает все надписи от рисунков и текста, обнуляет все переменные.

Состояние
В массиве Статус отмечаются расставленные значения в ячейках игрового поля: занятые крестиком — 1, ноликом — 10, а пусто — 0. Процедура Состояние находит суммы элементов массива на диагоналях, в строках и столбцах.

Диагональ1
Определяет в зависимости от Состояние, надо ли компьютеру ходить по главной диагонали и, если надо, то в какую ячейку.

Диагональ2
Определяет в зависимости от Состояние, надо ли компьютеру ходить по второй диагонали и, если надо, то в какую ячейку.

Бок, Верх
Определяет в зависимости от Состояние, надо ли компьютеру ходить и, если надо, то в какую ячейку.

    Приведем полный текст приложения. 

' Переменные уровня модуля
Dim Поле(1 To 3, 1 To 3) As Object
Dim Статус(1 To 3, 1 To 3) As Integer
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim Su(0 To 4, 0 To 4) As Integer

Private Sub CommandButton1_Click()
  ' Процедура переигрывания
  НачальноеСостояние
End Sub

Private Sub CommandButton2_Click()
  ' Закрытие диалогового окна
  UserForm1.Hide
End Sub

Private Sub Label1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean

  If Статус(1, 1) = 0 Then
    Поле(1, 1).Picture = LoadPicture("cross.bmp")
    Статус(1, 1) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(1, 2) = 0 Then
    Поле(1, 2).Picture = LoadPicture("cross.bmp")
    Статус(1, 2) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(1, 3) = 0 Then
    Поле(1, 3).Picture = LoadPicture("cross.bmp")
    Статус(1, 3) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(2, 1) = 0 Then
    Поле(2, 1).Picture = LoadPicture("cross.bmp")
    Статус(2, 1) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub


Private Sub Label5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(2, 2) = 0 Then
    Поле(2, 2).Picture = LoadPicture("cross.bmp")
    Статус(2, 2) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(2, 3) = 0 Then
    Поле(2, 3).Picture = LoadPicture("cross.bmp")
    Статус(2, 3) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(3, 1) = 0 Then
    Поле(3, 1).Picture = LoadPicture("cross.bmp")
    Статус(3, 1) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label8_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(3, 2) = 0 Then
    Поле(3, 2).Picture = LoadPicture("cross.bmp")
    Статус(3, 2) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Private Sub Label9_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim Inf As Boolean
  If Статус(3, 3) = 0 Then
    Поле(3, 3).Picture = LoadPicture("cross.bmp")
    Статус(3, 3) = 1
    k = k + 1
    Проверка Inf
    If Inf = True Then Exit Sub
    Strategy
    Проверка Inf
    If Inf = True Then Exit Sub
  End If
End Sub

Sub UserForm_Initialize()
  Set Поле(1, 1) = Label1
  Set Поле(1, 2) = Label2
  Set Поле(1, 3) = Label3
  Set Поле(2, 1) = Label4
  Set Поле(2, 2) = Label5
  Set Поле(2, 3) = Label6
  Set Поле(3, 1) = Label7
  Set Поле(3, 2) = Label8
  Set Поле(3, 3) = Label9

  НачальноеСостояние
End Sub

Sub Strategy()
  Dim flag As Boolean

  ' Стратегия первого хода
  If k = 1 Then
    Strategy_1
    Exit Sub
  End If

  If k = 2 And Su(0, 0) = 12 And Статус(2, 2) = 1 Then
    Поле(1, 3).Picture = LoadPicture("ou.bmp")
    Статус(1, 3) = 10
    Exit Sub
  End If

  If k = 2 And Статус(2, 2) = 10 And (Su(0, 0) = 12 Or Su(0, 4) = 12) Then
    Поле(1, 2).Picture = LoadPicture("ou.bmp")
    Статус(1, 2) = 10
    Exit Sub
  End If

  If k = 2 And Статус(2, 2) = 10 And Su(0, 0) = 11 And _
        (Статус(3, 2) = 1 Or Статус(2, 1) = 1) Then
    Поле(3, 1).Picture = LoadPicture("ou.bmp")
    Статус(3, 1) = 10
    Exit Sub
  End If

  Состояние

  Диагональ1 20, 10, flag

  If flag = True Then Exit Sub
  Диагональ2 20, 10, flag
  If flag = True Then Exit Sub

  For j = 1 To 3
    Бок 20, 10, j, flag
    If flag = True Then Exit Sub
  Next j

  For i = 1 To 3
    Верх 20, 10, i, flag
    If flag = True Then Exit Sub
  Next i

  Диагональ1 2, 10, flag
  If flag = True Then Exit Sub

  Диагональ2 2, 10, flag
  If flag = True Then Exit Sub

  For j = 1 To 3
    Бок 2, 10, j, flag
    If flag = True Then Exit Sub
  Next j

  For i = 1 To 3
    Верх 2, 10, i, flag
    If flag = True Then Exit Sub
  Next i

  Диагональ1 10, 10, flag
  If flag = True Then Exit Sub

  Диагональ2 10, 10, flag
  If flag = True Then Exit Sub

  For j = 1 To 3
    Бок 10, 10, j, flag
    If flag = True Then Exit Sub
  Next j

  For i = 1 To 3
    Верх 10, 10, i, flag
    If flag = True Then Exit Sub
  Next i

  For i = 1 To 3
    For j = 1 To 3
      If Статус(i, j) = 0 Then
        Поле(i, j).Picture = LoadPicture("ou.bmp")
        Статус(i, j) = 10
        Exit Sub
      End If
    Next j
  Next i
End Sub

Sub Strategy_1()
  If Статус(2, 2) = 0 Then
    Поле(2, 2).Picture = LoadPicture("ou.bmp")
    Статус(2, 2) = 10
  Else
    Поле(1, 1).Picture = LoadPicture("ou.bmp")
    Статус(1, 1) = 10
  End If
End Sub

Sub Проверка(ByRef Inf As Boolean)
  ' Процедура проверяет, не выиграл ли кто-то
  ' Если аргумент Inf равен True, то выигравший есть
  ' Если аргумент Inf равен False, то пока выигравшего нет

  Inf = False
  Состояние

  If Su(0, 0) = 3 Or Su(0, 0) = 30 Then
    Сообщение Su(0, 0)
    Inf = True
    Exit Sub
  End If

  If Su(0, 4) = 3 Or Su(0, 4) = 30 Then
    Сообщение Su(0, 4)
    Inf = True
    Exit Sub
  End If

  For j = 1 To 3
    If Su(0, j) = 3 Or Su(0, j) = 30 Then
      Сообщение Su(0, j)
      Inf = True
      Exit Sub
    End If
  Next j

  For i = 1 To 3
    If Su(i, 0) = 3 Or Su(i, 0) = 30 Then
      Сообщение Su(i, 0)
      Inf = True
      Exit Sub
    End If
  Next i

  ' Проверка, не завершилась ли игра
  For i = 1 To 3
    For j = 1 To 3
      If Статус(i, j) = 0 Then Exit Sub
    Next j
  Next i

  MsgBox "Пока фифти-фифти", vbExclamation, "Крестики-Нолики"
  Inf = True
End Sub

Sub Сообщение(Inf As Integer)
  ' Возможные сообщения о победителе
  ' Если Inf=3, то поздравления принимает игрок
  ' Если Inf=30, то поздравления принимает компьютер
  If Inf = 3 Then
    MsgBox "Поздравляю с выигрышем", vbExclamation, "Крестики-Нолики"
    Exit Sub
  End If

  If Inf = 30 Then
    MsgBox "Компьютер пока сильнее", vbExclamation, "Крестики-Нолики"
    Exit Sub
  End If
End Sub

Sub НачальноеСостояние()
  ' Обнуление данных и очистка картинок
  For i = 1 To 3
    For j = 1 To 3
      Поле(i, j).Caption = ""
      Поле(i, j).Picture = LoadPicture("")
      Поле(i, j).BorderStyle = fmBorderStyleSingle
      Статус(i, j) = 0
    Next j
  Next i
  
  k = 0
  For i = 0 To 4
    For j = 0 To 4
      Su(i, j) = 0
    Next j
  Next i
End Sub

Sub Состояние()
  Su(0, 0) = 0
  For i = 1 To 3
    Su(0, 0) = Su(0, 0) + Статус(i, i)
  Next i

  Su(0, 4) = 0
  For i = 1 To 3
    Su(0, 4) = Su(0, 4) + Статус(i, 4 - i)
  Next i

  For j = 1 To 3
    Su(0, j) = 0
    For i = 1 To 3
      Su(0, j) = Su(0, j) + Статус(i, j)
    Next i
  Next j

  For i = 1 To 3
    Su(i, 0) = 0
    For j = 1 To 3
      Su(i, 0) = Su(i, 0) + Статус(i, j)
    Next j
  Next i
End Sub

Sub Диагональ1(ByRef p, ByRef q, ByRef flag As Boolean)
  flag = False
  If Su(0, 0) = p Then
    For i = 1 To 3
      If Статус(i, i) = 0 Then
        Поле(i, i).Picture = LoadPicture("ou.bmp")
        Статус(i, i) = q
        flag = True
        Exit Sub
      End If
    Next i
  End If
End Sub

Sub Диагональ2(ByRef p, ByRef q, ByRef flag As Boolean)
  flag = False
  If Su(0, 4) = p Then
    For i = 1 To 3
      If Статус(i, 4 - i) = 0 Then
        Поле(i, 4 - i).Picture = LoadPicture("ou.bmp")
        Статус(i, 4 - i) = q
        flag = True
        Exit Sub
      End If
    Next i
  End If
End Sub

Sub Бок(ByRef p, ByRef q, ByRef j, ByRef flag As Boolean)
  flag = False
  If Su(0, j) = p Then
    For i = 1 To 3
      If Статус(i, j) = 0 Then
        Поле(i, j).Picture = LoadPicture("ou.bmp")
        Статус(i, j) = q
        flag = True
        Exit Sub
      End If
    Next i
  End If
End Sub

Sub Верх(ByRef p, ByRef q, ByRef i, ByRef flag As Boolean)
  flag = False
  If Su(i, 0) = p Then
    For j = 1 To 3
      If Статус(i, j) = 0 Then
        Поле(i, j).Picture = LoadPicture("ou.bmp")
        Статус(i, j) = q
        flag = True
        Exit Sub
      End If
    Next j
  End If
End Sub
Текст этого примера можно взять здесь.

    На следующем шаге мы продолжим разработку приложений.




Предыдущий шаг Содержание Следующий шаг