ЗАДАНИЕ 6
ИНТЕРАКТИВНАЯ ПРОГРАММА: ИГРА 15
Ключевые понятия: Переопределение стандартных событий (Metod) листа (Worksheet), которые возникают перед перед нажатием правой клавиши
(Worksheet_BeforeRightClick) и левой клавиши (Worksheet_SelectionChange) манипулятора.
ЗАДАЧА № 3.
Написать программу реализующую интерактивную игру Пятнашки 15. В «клетчатой области» ЭТ 4х4 случайно записываем числа от 1 до 15. Одна ячейка остается пустой. После выделения ячейки с цифрой рядом с пустой происходит обмен значениями. Задача состоит в том, чтобы собрать все цифры в порядке возрастания слеванаправо и сверху-вниз.
1.Выделить и сделать равномерными ячейки игрового поля. Предусмотреть границу вокруг игрового поля. Граница должна быть заполнена любыми символами из Таблицы символов. Переименовать Лист1 ЭТ в Игра 15.
2.
3.Написать процедуру перемешивания и заполнения игрового поля случайными числами Sub Miхed(). Разместить кнопку ря-
65
дом с игровым полем и назначить выполнение макроса Miхed на ее нажатие.
' размер игрового поля
Const n = 4
'цвет фона клеток игрового поля
Const F_color = 6
'количество пустых циклов
'время в миллисекундах для задержки выполнения
'в процедуре WaitGame
Const t = 12345
___________________________________________________
Sub Miхed()
'Процедура расстановка 15 номеров 'в случайные клетки для заполнения
'игрового поля перед началом новой игры. 'Объявление размерности переменных.
Dim k As Byte, i As Byte, j As Byte, l As Byte
'Объявление динамической размерности массива
ReDim a(n, n) As Byte
'очистка игрового поля
For i = 1 To n
For j = 1 To n
'клетки по очереди заполняются пустотой cells(i + 1, j + 1) = ""
'и закрашиваются выбранным цветом фона
'интерьера
cells(i + 1, j + 1).Interior.ColorIndex = F_color Next
Next
'расстановка 15 номеров
For k = 1 To (n * n) - 1
'получение адреса случ. ячейки элемента массива
Do
i = Rnd * (n - 1) + 1
j = Rnd * (n - 1) + 1
'проверка что этот элемент нуль иначе ищи новый
Loop Until a(i, j) = 0
'присвоение нулевому элементу текущего номера
a(i, j) = k
' заполнение игрового поля cells(i + 1, j + 1) = a(i, j) Next k
cells(7, 2) = "Начата новая игра!"
End Sub
66
4.Написать программы проверки состояния игрового поля для определения выигрыша.
Sub CheckWin()
'Процедура проверки окончания игры 'если все 15 номеров расставлены 'то выводится сообщение о победе
'и запускается салют, иначе игра продолжается
'Объявление размерности переменных
Dim k As Byte, i As Byte, j As Byte, l As Byte
'Проходим по всем клеткам игрового поля
For i = 1 To n For j = 1 To n
'рассчитываем текущий номер
k = j + (i - 1) * n
' и если он не совпадает с номером в клетки
If cells(i + 1, j + 1).Value <> k And k < n * n Then
' пишем сообщение
cells(7, 2) = "Проверка завершена. Продолжаем Игру!"
' и выходим из процедуры проверки
Exit Sub End If
Next j Next i
'иначе выводим сообщение о победе cells(7, 2) = "Игра завершена с Победой!" MsgBox "Салют! Победы!"
'и запускам в каждой клетке
For i = 1 To n For j = 1 To n
k = (j + (i - 1) * n)
'от 50 до 34 изменений цвета фона
For l = 50 To k Step -1
'процессор это делает очень быстро
'поэтому его нужно заставить работать
'некоторое время, например, извлекая тысячу раз
'корень из 1
Call WaitGame(t)
cells(i + 1, j + 1).Interior.ColorIndex = l + 5 Next l
Next j Next i End Sub
67
5.Написать программу остановки выполнения процедуры
Sub CheckWin для корректного отображения результата на экране. Чтобы проверить необходимость процедуры Sub WaitGame(t) задайте временно значение Const t = 0
Sub WaitGame(t)
'Пустая процедура, реализующая задержку
'работы процессора над алгоритмом
'сам процессор занят работой извлечения
't раз корень из 1. Для разных процессоров
'это число подбирается опытным путем
Dim m As Long, p As Single For m = 1 To t
p = 1^0.5
'метод Doevents опрашивает устройства
'на предмет возникновения события
'в момент задержки
DoEvents
Next m
End Sub
6.Для создания интерактивных процедур, которые будут реагировать на нажатие левой или правой клавиши манипулятора (мыши), необходимо в редакторе выделить VB объект Лист1(Игра 15). В правой части редактора в верхнем левом окне списка сменить объект General на Worksheet, а в правом верхнем окне выбрать шаблон стандартного события (метода)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Не меняя заголовок события, написать процедуру, которая будет выполняться при нажатии (щелчок) на левую клавишу мыши (ЛКМ) в любой клетке (Cells) объекта лист (Worksheet).
68
7. По аналогии с предыдущим пунктом, в правом верхнем окне выбрать шаблон стандартного события (метода)
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End Sub
Не меняя заголовок события, написать процедуру, которая будет выполняться при нажатии (щелчок) на левую клавишу мыши ПКМ объекта лист (Worksheet).
'стандартная процедура щелчок
'правой клавиши мыши ПКМ объекта лист (worksheet)
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Cancel = True
Dim r As Byte, c As Byte
'Объект Target из семейства Range хранит значения
'номера столбца Target.Row и номера строки Target.Column
'для удобства работы присваиваем эти значения нашим переменным r = Target.Row
c = Target.Column
'если мы попадаем внутрь игрового поля,
If r > 1 And r < 6 And c > 1 And c < 6 Then
'то вызываем процедуру поиска пустой ячейки
Call StepGame(r, c)
'и вызываем процедуру проверки окончания Игры из Модуля1
Call Module1.CheckWin
End If
End Sub
Написать процедуру StepGame(r, c) ниже на листе редактора, которая проверяет и меняет местами пустую и выбранную клетку.
69
'Создаем отдельную процедуру поиска пустой ячейки
Sub StepGame(r, c)
'Ищем пустую ячейку вверху над cells(r, c)
If cells(r - 1, c) = "" Then
'Присваиваем значение cells(r, c) ячейки вверху, cells(r - 1, c) = cells(r, c)
'а значение cells(r, c) делаем пустым
cells(r, c) = ""
End If
'Ищем пустую ячейку внизу под cells(r, c)
If cells(r + 1, c) = "" Then cells(r + 1, c) = cells(r, c) cells(r, c) = ""
End If
'Ищем пустую ячейку слева около cells(r, c)
If cells(r, c - 1) = "" Then cells(r, c - 1) = cells(r, c) cells(r, c) = ""
End If
'Ищем пустую ячейку справа около cells(r, c)
If cells(r, c + 1) = "" Then cells(r, c + 1) = cells(r, c) cells(r, c) = ""
End If
End Sub
Теперь можно перейти на лист ЭТ и наслаждаться игрой. После составления последовательности цифр в правильном порядке Вас поздравят с победой. Удачи!
Самостоятельно.
Подумайте и измените программу так, чтобы она записывала имя игрока, дату игры и время затраченное на игру.
70