Игра «Минное поле»

Листинг 6.2.Код в модуле рабочего листа

Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim intCol As Integer, intRow As Integer

Dim intMinesAround As Integer

Dim fInGameField As Boolean

' Определим, попадает ли в игровое поле выделенная ячейка

fInGameField = (Target.Row >= 2) And (Target.Row <= 7) _

And (Target.Column >= 2) And (Target.Column <= 7)

' Обрабатываем выделение ячейки

If Target.Value = "*" And fInGameField Then

' Пользователь выделил ячейку с миной - покажем мину

Target.Font.Color = RGB(0, 0, 0)

Target.Interior.Color = RGB(255, 0, 0)

' Пользователь проиграл!

EndGame

ElseIffInGameFieldThen

' Пользователь выделил пустую ячейку. Оформим эту ячейку

Target.Interior.Color=RGB(0, 0, 255)

Target.Font.Color = RGB(0, 255, 0)

Target.Font.Size = 16

' Подсчитаем количество мин рядом с ячейкой (вокруг ячейки)

For intCol = Target.Column - 1 To Target.Column + 1

For intRow = Target.Row - 1 To Target.Row + 1

If Target.Worksheet.Cells(intRow, intCol).Value = "*" _

Then

' Нашли очередную мину

intMinesAround = intMinesAround + 1

EndIf

Next

Next

' Отображение количества мин

Target.Value = intMinesAround

End If

End Sub

Листинг 6.3.Код в стандартном модуле

SubNewGame()

' Начало новой игры

' Подготовим поле для игры

InitGame

Dim intRow As Integer, intCol As Integer

Dim intMinesCount As Integer ' Количество мин

' Расставляем мины (то есть в случайные ячейки помещаем _

значения "*" и делаем цвет шрифта таким же, как цвет _

фона этих ячеек)

For intMinesCount = 1 To 10

' Строка для мины (от 2 до 7)

intRow=Int((6 *Rnd) + 1) + 1

' Столбец для мины (от 2 до 7)

intCol=Int((6 *Rnd) + 1) + 1

' Ставим мину, если ячейка пустая

If Cells(intRow, intCol) <> "*" Then

Cells(intRow, intCol).Font.Color = _

Cells(intRow, intCol).Interior.Color

Cells(intRow, intCol).Value = "*"

Else

' В данной ячейке мина есть - продолжим поиск ячеек

intMinesCount=intMinesCount- 1

EndIf

Next

' Вывод информации о количестве мин в строку состояния

Application.StatusBar = "Количество мин " & intMinesCount

End Sub

SubInitGame()

' Раскраска (оформление) листа перед началом игры

Dim intRow As Integer, intCol As Integer

' Цвет фона всех ячеек

Cells.Interior.Color = RGB(0, 200, 75)

' Цвет шрифта всех ячеек

Cells.Font.Color = RGB(0, 0, 0)

' Размер шрифта

Cells.Font.Size = 18

' Все надписи - по центру

Cells.HorizontalAlignment = xlCenter

' Всем ячейкам игрового поля назначим особый цвет

For intRow = 2 To 7

For intCol = 2 To 7

Cells(intRow, intCol).Interior.Color = RGB(200, 200, 200)

Cells(intRow, intCol).Value = ""

Next

Next

EndSub

SubEndGame()

' Завершение игры (поражение)

Dim intRow As Integer, intCol As Integer

' Покажем все мины. Для этого сделаем цвет шрифта всех ячеек _

черным (ведь во всех ячейках с минами "*" цвет шрифта и цвет _

заливки одинаковы)

For intRow = 2 To 7

For intCol = 2 To 7

If Cells(intRow, intCol).Value = "*" Then

Cells(intRow, intCol).Font.Color = RGB(0, 0, 0)

End If

Next

Next

MsgBox "Проигрыш"

EndSub