загрузить пример
Каждый программист в своей жизни написал хотя бы одну
игрушку. Не являются исключением из этого правила и те, кто пишет на VB. Другой
разговор, что более ранние версии VB были более громоздкими и достаточно
медленными. Относительно медленными были и сами компьютеры. С годами постепенно
положение изменилось. И хотя, VB стал еще более громоздким, однако скорость
работы, особенно с графикой выросла значительно.
В статье я хочу показать, что на обычном
VB6 можно писать интересные приложения. А для тех, кто посвятит себя в
дальнейшем программированию игр – это будет начальным трамплином. Итак, шаг за
шагом мы создадим компьютерную игру. Для тех, кто спешит, есть готовый Листинг.
Ну а для самых ленивых и готовые Исходники на VB. После каждого шага, нажав на
клавишу F5, Вы сможете увидеть те изменения, которые Вы внесли в программу. Для
того, чтобы случайно не потерять свои данные, рекомендую Вам производить
сохранения проекта после каждого шага.
Шаг 1. Самый главный.
Необходимо определить, что же мы хотим "представить
миру". Именно на этапе планирования и определяется будущий вид, структура и
взаимодействие различных частей программы. Те, кто постарше, наверно помнят то
время, когда персональные компьютеры были недосягаемой мечтой. Именно тогда
появились в России первые игровые автоматы, на которых за 15 копеек можно было
попускать торпеды в корабли, поучаствовать в скачках, ну и конечно, порулить.
Отдавая дань памяти тем временам, я решил предложить Вам написать совместно
игровую программу AutoRoad. Она будет состоять из двух форм (основной,
содержащей игровое поле, и вспомогательной для вывода пользовательских
настроек), модуля, а так же ActivX Control'а.
Хочу сразу же обратить Ваше внимание на то, что в ряде
случаев, для ускорения обработки графики, мы будем обращаться к API-функциям.
Всем известно (а кому не известно – "мотайте на ус"), что API-функции работают
только с пикселами. Поэтому на основной форме (где будет находиться игровое
поле) и сама форма и все элементы, расположенные на ней, должны будут иметь
свойство ScaleMode = 3 (pixel).
Шаг 2. Создайте новый проект StandartEXE и дайте
ему имя AutoRoad. Для формы измените следующие параметры:
Name = frmMain
Caption = AutoRoad
Icon – иконку можете вставить мою, или
какая Вам больше понравится
ScaleMode = 3 – Pixel
StartupPosition = 2 – CenterScreen
Разместите на форме 2 PictureBox. Первый с
параметрами:
Name = picRoad
AutoRedraw = True
BorderStyle = 0 – None
Height = 461
Left = 8
ScaleMode = 3 – Pixel
Top = 0
Width = 331
Второй PictureBox с параметрами:
Name = picSrc
AutoRedraw = True
AutoSize = True
BorderStyle = 0 – None
Left = 368
Picture – загрузите Auto.bmp
ScaleMode = 3 – Pixel
Top = 364
Visible = False
NB! На случай создания своих картинок,
Auto.bmp построена следующим образом: в первом ряду – управляемое игроком авто,
во втором – 6 авто, двигающихся навстречу, в третьем – 6 авто по ходу движения с
основным автомобилем. Размеры каждого авто 23 пиксела в ширину и 31 пиксел в
высоту. Если Вы захотите нарисовать автомобили других размеров, необходимо будет
сделать соответствующие изменения в кодах.
Лирическое отступление 1. Если Вы впоследствии
переименуете проект и даже сохраните его под другим именем, все равно VB будет
предлагать компилировать его в ехе-файл только с первоначальным именем. Закройте
проект, а затем в каком либо текстовом редакторе откройте файл Вашего проекта с
расширением vbp, и строке ExeName32, впишите то название, какое Вы хотите
увидеть.
Шаг 3. Пошли дальше.
Нарисуем дорогу. В frmMain в разделе деклараций запишем
процедуру, которая будет рисовать игровое поле:
Public Sub
DrawRoad()
picRoad.Line
(0, 0)-(picRoad.Width * 0.05, picRoad.Height), vbGreen, BF
picRoad.Line (picRoad.Width
* 0.95, 0)-(picRoad.Width, picRoad.Height), vbGreen, BF
picRoad.Line (picRoad.Width
* 0.05, 0)-(picRoad.Width * 0.95, picRoad.Height), vbBlack, BF
picRoad.Line (picRoad.Width
* 0.5, 0)-(picRoad.Width * 0.5, _ picRoad.Height), vbYellow, BF
End Sub
Первая и вторая строки рисуют зеленый бордюр по краям,
третья строка – непосредственно саму дорогу, и наконец четвертая –
разделительную желтую линию.
Шаг 4. Займемся теперь нашим авто. Для копирования его на
игровое поле будем использовать API-функцию StretchBlt.
Вначале добавим к программе модуль Project/Add Module, и
назовем его Name = mdlAuto. В раздел деклараций модуля запишем объявление данной
функции
Public Declare Function StretchBlt Lib "gdi32"
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long,
ByVal nHeight As Long,ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As
Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As
Long
а так же константу, необходимую для последнего параметра
Public Const SRCCOPY = &HCC0020
Коротко по параметрам данной функции: первый – требует
указания, куда мы будем копировать, со второго по пятый соответственно
координаты левого верхнего угла, а так же ширину и высоту получаемой картинки;
шестой параметр указывает, откуда мы эту картинку берем, с седьмого по десятый
соответственно координаты левого верхнего угла вырезаемой картинки, а так ее
ширина и высота; последний параметр говорит о типе проводимой операции – в нашем
случае копировании.
Теперь определимся с координатами нашего авто;
отслеживать их нам поможет тип POINTAPI, который мы так же объявим в разделе
деклараций модуля.
Public Type POINTAPI
x As Long
y As Long
End Type
Наконец, объявим переменную для координат нашего авто:
Public Auto As POINTAPI
На этом закончим предварительный этап копирования нашего
авто и перейдем в форму.
Лирическое отступление 2. Вместо API-функции StretchBlt можно
использовать встроенную в VB функцию – PaintPicture, которая не просто повторяет
ее, но и целиком и полностью на нее опирается.
Шаг 4а. В декларациях формы запишем процедуру:
Public Sub DrawAuto()
StretchBlt picRoad.hdc, Auto.x, Auto.y, 23, 31, picSrc.hdc, 0, 0, 23, 31,
SRCCOPY
End Sub
Здесь данная функция вырезает из общей картинки первый
автомобиль и копирует его на дорогу. Объединим процедуры перерисовки дороги и нашего авто в
единую процедуру, к которой мы в дальнейшем будем неоднократно обращаться.
Public Sub RedrawPic()
DrawRoad
DrawAuto
End Sub
Теперь, чтобы это все заработало, вернемся в модуль и
напишем запускающую процедуру:
Public Sub Main()
With frmMain
.Show
.RedrawPic
End With
End Sub
NB! Не забудьте сделать процедуру Main стартовой при запуске
проекта. Для этого в меню Project/AutoRoad Properties … в выпадающем списке
StartupObject выберите Sub Main и нажмите ОК.
Запустим проект (клавиша F5). На данном этапе должна быть
дорога и в верхнем левом углу ее – наш автомобиль. Как говорится, все хорошо, но
ему там не место. Проецирование автомобиля в верхний левый угол произошло
потому, что по умолчанию тип POINTAPI дает начальное значение для x и y равным
нулю. Давайте сразу же исправим это. Наш авто должен располагаться
приблизительно посередине левой полосы дороги. Допишем 2 строки в процедуру Main,
инициализирующие начальные координаты авто:
Public Sub Main()
With frmMain
Auto.x = .picRoad.Width * 0.75
Auto.y = .picRoad.Height * 0.5
Show
.RedrawPic
End With
End Sub
Еще раз запустим проект и посмотрим все ли правильно
получилось у нас.
Шаг 5. Переходим к перемещению нашего авто. В
нашем случае, автомобиль должен уметь перемещаться вправо и влево. Для этого
используем событие KeyDown, так как оно позволяет обращаться к конкретным
клавишам клавиатуры.
Private Sub picRoad_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
Auto.x = Auto.x - 2
Case vbKeyRight
Auto.x = Auto.x + 2
End Select
RedrawPic
End Sub
При нажатии на левую клавишу происходит смещение
координаты х на 2 пиксела влево, на правую клавишу – соответственно на 2 пиксела
вправо. После чего перерисовываем всю картинку с новыми координатами для авто.
Одно маленькое неудобство – при длительном нажатии наше авто "уезжает" за край
картинки. Ограничим его перемещения, учитывая так же зеленый бордюр:
Private Sub picRoad_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
If Auto.x <= picRoad.Width * 0.05 Then Exit Sub
Auto.x = Auto.x - 2
Case vbKeyRight
If Auto.x >= picRoad.Width * 0.95 - 23 Then Exit Sub
Auto.x = Auto.x + 2
End Select
RedrawPic
End Sub
Итак, на данном этапе мы добились прорисовки дороги,
размещения на нем автомобиля и перемещения его вправо и влево. Поэтому сохраним
проект и можем переходить к …
Шаг 6. … отображению других авто (встречных и
попутных). В принципе, различие между отображением нашего авто и других авто –
одно: наш автомобиль – один, а других – много. Поэтому воспользуемся теми же
принципами прорисовки других авто, что и раньше. Единственное исключение
сделаем для упрощения просчета координат в этой массе автомобилей: объявим
массив. В модуле сделаем объявление:
Public OtherAuto(0 To 11) As POINTAPI
' от 0 до 5 - навстречу, от 6 до 11 - по ходу
В форме напишем функцию, описывающую прорисовку одного
"другого" авто:
Public Sub DrawOtherAuto(Num As Integer)
Select Case Num
Case 0 To 5
StretchBlt picRoad.hdc, OtherAuto(Num).x, OtherAuto(Num).y, 23, 31,
picSrc.hdc, Num * 23, 31, 23, 31, SRCCOPY
Case 6 To 11
StretchBlt picRoad.hdc, OtherAuto(Num).x, OtherAuto(Num).y, 23, 31,
picSrc.hdc, (Num - 6) * 23, 62, 23, 31, SRCCOPY
End Select
End Sub
Принцип построения процедуры такой же, как и у нашего
авто. Различие в вырезании из общей картинки: вырезается авто под номером Num
(при ширине 23 пиксела) и начиная с соответствующей строки (соответственно, в
зависимости от направления движения с 31 или 62 пиксела). В процедуру RedrawPic
внесем изменения, для отображения других авто. В итоге она должна выглядеть
так:
Public Sub RedrawPic()
Dim i%
DrawRoad
DrawAuto
For i = 0 To 11
DrawOtherAuto (i)
Next
End Sub
В запускающей процедуре Main, так же сделаем изменения,
которые отобразят начальные координаты других машин:
Public Sub Main()
Dim i%
With frmMain
Auto.x = .picRoad.Width * 0.75
Auto.y = .picRoad.Height * 0.5
For i = 0 To 5
'добавляется по 2 пиксела к 23 для расстояния
между машинами
OtherAuto(i).x = (i * 25) + (.picRoad.Width * 0.05)
OtherAuto(i).y = 0
Next
For i = 6 To 11
'добавляется по 2 пиксела к 23 для
расстояния между машинами
OtherAuto(i).x = ((i - 6) * 25) + (.picRoad.Width * 0.5)
OtherAuto(i).y = .picRoad.Height - 31
Next
.Show
RedrawPic
End With
End Sub
Для машин от 0 до 5 (двигающихся навстречу) координата х
будет равна порядковому номеру авто + его ширина (23 пиксела). Но чтобы машины
не "слипались" друг с другом бортами – добавим на ширину еще по 2 пиксела. Плюс
учитываем ширину зеленого бордюра. Для попутных авто (от 6 до 11) – все тоже
самое, только расчет будет идти от середины дороги. Координату y, временно, пока
приравняем к тем цифрам, чтобы встречные авто располагались сверху картинки, а
попутные – снизу. Такая симметрия нехарактерна для жизни, поэтому чуть позже мы
к этому вернемся и исправим.
Шаг 7. Машины отображены, теперь самое время
заставить их двигаться. Желая придать естественность движению на дороге эту
часть мы будем неоднократно изменять, поэтому вместо сразу конечного результата,
я покажу каким путем мы подошли к нему. Сначала внесем изменения в форму. Итак,
откроем форму frmMain и расположим на ней таймер, со следующими параметрами:
Name = tmrMove
Enabled = False
Interval = 100
Добавим меню:
Caption = "&AutoRoad"
Name = mnuAutoRoad
и подменю:
Caption = "&Новая"
Name = mnuNew
Shortcut = F2
Caption = "Н&астройки"
Name = mnuOptions
Shortcut = F3
Caption = "-"
Name = mnuSep
Caption = "&Выход"
Name = mnuExit
Shortcut = F12
Лирическое
отступление 3. В редакторе меню для VB почему-то не предусмотрена клавиша F10,
которой мы привыкли закрывать приложения, начиная еще с DOS'а. Вообще-то
добавить клавишу F10 не сложно, но получается более громоздко. А делается это
так: На форме в окне свойств устанавливаем свойство KeyPreview = True; далее
записываем процедуру:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode Case vbKeyF10
'здесь мы записываем, какое меню
обрабатываем, например
mnuExit_Click
End Select
End Sub
Ну и в самом
событии меню пишем, что же мы хотели все-таки сделать.
Чтобы избежать данных громоздкостей, я поэтому
остановился на клавише F12 для данной учебной программы.
Шаг 8. Сначала опишем действия меню (меню
Настройки займемся чуть позже, когда будем проектировать соответствующую форму).
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuNew_Click()
tmrMove.Enabled = True
End Sub
Меню Exit – просто выгружает форму, а меню Новая игра –
запускает таймер движения авто.
В событии таймера опишем движения авто:
Private Sub tmrMove_Timer()
Dim i%
For i = 0 To 5
OtherAuto(i).y = OtherAuto(i).y + 2
Next
For i = 6 To 11
OtherAuto(i).y = OtherAuto(i).y - 2
Next
RedrawPic
End Sub
+ или – 2 – это смещение на 2 пиксела по вертикали,
относительно нынешней
координаты.
Учитывая, что перерисовка картинки у нас происходит
достаточно часто, согласно таймеру, каждые 0.1 сек, то в процедуре движения
нашего авто, мы эту перерисовку можем опустить. Удалите из picRoad_KeyDown
последнюю строку (RedrawPic).
Запустим и посмотрим: авто двинулись как на параде!
Проехали за край и исчезли, а нам хотелось бы повторяемости. Поэтому добавим
отслеживание координаты y каждого авто и при полном исчезновении за краем
картинки дороги прорисовываем его на противоположной стороне:
Private Sub tmrMove_Timer()
Dim i%
For i = 0 To 5
If OtherAuto(i).y >= picRoad.Height Then
OtherAuto(i).y = -31
ElseIf OtherAuto(i).y <= -31 Then
OtherAuto(i).y = picRoad.Height
End If
OtherAuto(i).y = OtherAuto(i).y + 2
Next
For i = 6 To 11
If OtherAuto(i).y >= picRoad.Height Then
OtherAuto(i).y = -31
ElseIf OtherAuto(i).y <= -31 Then
OtherAuto(i).y = picRoad.Height
End If
OtherAuto(i).y = OtherAuto(i).y - 2
Next
RedrawPic
End Su
Попробуем запустить еще раз. Авто "строем" доезжают до
края дороги и появляются с противоположной стороны. Уже лучше! Но по прежнему
неестественно. Некоторые, наверно замечали, что на магистрали автомобили,
желающие ехать быстрее, располагаются ближе к осевой линии. Давайте и мы внесем
эти изменения в движение нашего транспорта и смещение каждого авто будет не на 2 пиксела, а на 2 + порядковый номер авто.
Private Sub tmrMove_Timer()
Dim i%
For i = 0 To 5
If OtherAuto(i).y >= picRoad.Height Then
OtherAuto(i).y = -31
ElseIf OtherAuto(i).y <= -31 Then
OtherAuto(i).y = picRoad.Height
End If
OtherAuto(i).y = OtherAuto(i).y + 2 + i
Next
For i = 6 To 11
If OtherAuto(i).y >= picRoad.Height Then
OtherAuto(i).y = -31
ElseIf OtherAuto(i).y <= -31 Then
OtherAuto(i).y = picRoad.Height
End If
OtherAuto(i).y = OtherAuto(i).y - 2 - (13 - i)
Next
RedrawPic
End Sub
Запустим проект и понаблюдаем за движением авто.
Шаг 9. Движение стало более "осмысленным". Немного
смущает стартовое положение авто (в одну линию). Давайте поправим это. Для
генерации случайных чисел в VB существует функция Randomize. Вот ею мы и
воспользуемся для определения "случайного" положения авто по вертикали при
загрузке программы. Внесем изменения в процедуру Main, расположенную в модуле:
Public Sub Main()
Dim i%
With frmMain
Auto.x = .picRoad.Width * 0.75
Auto.y = .picRoad.Height * 0.5
Randomize
For i = 0 To 5
OtherAuto(i).x = (i * 25) + (.picRoad.Width * 0.05)
OtherAuto(i).y = Int((.picRoad.Height + 1) * Rnd)
Next
For i = 6 To 11
OtherAuto(i).x = ((i - 6) * 25) + (.picRoad.Width * 0.5)
OtherAuto(i).y = Int((.picRoad.Height + 1) * Rnd)
Next
.Show
.RedrawPic
End With
End Sub
Теперь при открытии формы и встречные и попутные авто
располагаются в случайном порядке.
Лирическое отступление 4. Функция Randomize в общем
виде выглядит следующим образом: Сначала производится генерация случайного числа
от 0 до 1 Randomize, А затем, с учетом верхней и нижней границ для случайных
чисел, производится вычисление: Int((ВерхняяГраница - НижняяГраница + 1) * Rnd +
НижняяГраница)
Шаг 10. Автомобили едут, согласно предписаний. И
только наше авто может перемещаться вправо и влево с нулевой скоростью движения
вперед. Пора заняться скоростными качествами нашего авто. Откроем форму и
добавим два лейбла.
Первый:
Name = lblCaption
Caption ="Скорость:"
Font.Bold = True
Font.Size = 10
ForeColor = &H00FF0000&
Height = 16
Index = 0
Left = 348
Top = 64
Width = 74
И
второй:
Name = lblSpeed
AutoSize = True
Caption ="0"
Font.Bold = True
Font.Size = 10
oreColor = &H00FF0000&
Height = 16
Left = 428
Top = 64
Добавим новую переменную в раздел деклараций модуля:
Public Speed As Integer
В форме в процедуру picRoad_KeyDown внесем дополнения для
нажатий на клавиши вверх-вниз. Для клавиши "вниз" сразу же исключим
отрицательные значения скоростей. Для клавиши "вверх" – ограничение максимальной
скорости мы введем позже. После изменения скорости отобразим это в
соответствующем лейбле, выбрав чисто эмпирически коэффициент для приближения к
действительности (я решил, что таким коэффициентом может быть, например, 20)
Private Sub picRoad_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyUp
Speed = Speed + 1
lblSpeed.Caption = Speed * 20
Case vbKeyDown
Speed = Speed - 1
If Speed < 0 Then Speed = 0
lblSpeed.Caption = Speed * 20
End Select
End Sub
Если сейчас запустить проект, то мы увидим изменения,
происходящие в отображении скорости (т.е. в лейбле), но никак это не отобразится
на самом движении автомобилей. Поэтому, заканчивая шаг 10, сделаем "видимым"
наше изменение скорости. Т.е. попутные авто с увеличением скорости должны
двигаться относительно нас медленнее, а встречные на ту же самую скорость –
быстрее. Для этого добавим значение переменной Speed к скорости перемещения всех
авто.
Private Sub tmrMove_Timer()
Dim i%
For i = 0 To 5
If OtherAuto(i).y >= picRoad.Height Then
OtherAuto(i).y = -31
ElseIf OtherAuto(i).y <= -31 Then
OtherAuto(i).y = picRoad.Height
End If
OtherAuto(i).y = OtherAuto(i).y + 2 + i + Speed
Next
For i = 6 To 11
If OtherAuto(i).y >= picRoad.Height Then
OtherAuto(i).y = -31
ElseIf OtherAuto(i).y <= -31 Then
OtherAuto(i).y = picRoad.Height
End If
OtherAuto(i).y = OtherAuto(i).y - 2 - (13 - i) + Speed
Next
RedrawPic
End Sub
Фух-х-х! Пол-дела сделано! :-)))
Шаг 11. Теперь
ответственный момент – мы должны отреагировать на столкновение автомобилей. В
нашей игрушке это должно произойти, когда любая точка нашего авто пересечется с
любой точкой любого другого авто. Запишем эту процедуру:
Private Sub Crash()
Dim i%
For i = 0 To 11
'при совпадении координат
'по вертикали
If ((Auto.y + 31 >= OtherAuto(i).y) And (Auto.y + 31 <= OtherAuto(i).y +
31)) _
Or ((Auto.y >= OtherAuto(i).y) And (Auto.y <= OtherAuto(i).y + 31)) Then
'+ по горизонтали
If ((Auto.x + 23 >= OtherAuto(i).x) And (Auto.x + 23 <= OtherAuto(i).x
+ 23)) _
Or ((Auto.x >= OtherAuto(i).x) And (Auto.x <= OtherAuto(i).x + 23)) Then
' т.е. при столкновении - обнуляем
скорость нашего авто
Speed = 0
lblSpeed.Caption = "0"
End If
End If
Next
End Sub
Данная процедура должна проверяться постоянно при
движении всех авто – т.е. в процедуре таймера, непосредственно перед
перерисовкой всех объектов:
Private Sub tmrMove_Timer()
Crash
RedrawPic
End Sub
Теперь при запуске проекта, в период столкновения
скорость нашего авто сбрасывается до нуля.
Шаг 12. Продолжаем улучшать внешний вид нашей
игры. Добавим еще 2 лейбла для отображения пройденного нашим автомобилем пути.
Первый с параметрами:
Name = lblCaption
Caption ="Пройденный путь:"
Font.Bold = True
Font.Size = 10
ForeColor = &H000000FF&
Height = 16
Index = 1
Left = 348
Top = 84
Width = 136
И
второй:
Name = lblPath
AutoSize = True
Caption ="0"
Font.Bold = True
Font.Size = 10
ForeColor = &H000000FF&
Height = 16
Left = 488
Top = 84
В событие таймера внесем изменения пройденного
расстояния. Если верить учебнику математики за 3 класс, то расстояние
высчитывается по формуле S = v * t. И скорость и интервал времени у нас известны.
Private Sub tmrMove_Timer()
...
Crash
lblPath.Caption = lblPath.Caption + (lblSpeed.Caption * 0.01)
RedrawPic
End Sub
Теперь, запустив проект, мы увидим, что в зависимости от
скорости расстояние нарастает, соответственно, быстрее или медленнее.
Шаг 13. Любая игра имеет свои ограничения. Чаще
всего это бывает ограничением по времени. Не будем оригинальными и ограничим
пользователя, допустим, 1 минутой. Отсчет времени должен видеть пользователь,
поэтому на форме frmMain расположим еще 2 лейбла и новый таймер.
Первый лейбл:
Name = lblCaption
Caption ="Время игры:"
Font.Bold = True
Font.Size = 10
ForeColor = &H00000000&
Height = 16
Index = 2
Left = 348
Top = 104
Width = 90
Второй лейбл:
Name = lblTime
AutoSize = True
Caption ="0:01:00"
Font.Bold = True
Font.Size = 10
ForeColor = &H00000000&
Height = 16
Left = 444
Top = 104
Таймер:
Name = tmrTime
Enabled = False
Interval = 1000
Добавим в процедуру запуска новой игры инициализацию
второго таймера.
Private Sub mnuNew_Click()
tmrMove.Enabled = True
tmrTime.Enabled = True
End Sub
А в процедуру работы самого таймера добавим обратный
отсчет времени и остановку игры по его истечении, а также обнуление переменной Speed.
Private Sub tmrTime_Timer()
lblTime.Caption = CDate(CDate(lblTime.Caption) - CDate("0:00:01"))
If lblTime.Caption = "0:00:00" Then
tmrMove.Enabled = False
tmrTime.Enabled = False
MsgBox "Пройденное расстояние - " & lblPath.Caption & " км.",
vbInformation + vbOKOnly, "Игра закончена"
lblSpeed.Caption = "0"
lblPath.Caption = "0"
lblTime.Caption = "0:01:00"
Speed = 0
End If
Итак, в черновике игра сделана. У нас есть автомобиль,
которым мы управляем (скорость и направление); встречные и попутные машины,
двигающиеся с различной скоростью, столкновение с которыми, ведет к остановке
нашего автомобиля; мы можем отслеживать нашу скорость и пройденный путь, а так
же зафиксировать остановку игры через определенный интервал времени. В таком
случае напрашивается вопрос: "Чего будет недостаточно пользователю в данной
игрушке?" Ответ – один: ощущения, что он сам может устанавливать правила игры.
Давайте позволим ему тешиться этой мыслью и предоставим ему "свободу" в том
объеме, в котором мы сами пожелаем. Итак ...
Шаг 14. Собираем форму "Настройки". Вызываем меню:
Project/Add Form и выбираем обычную форму. Ее параметры:
Name = frmOption
BorderStyle = 1 – Fixed Single
Caption = "Настройки"
Height = 1815
Icon – устанавливаем ту же, что и на основную форму
StartupPosition = 1 – CenterOwner
Width = 4860
NB! В данной форме мы не будем работать с графикой и
API-функцией, поэтому нет смысла изменять свойство ScaleMode. В этой форме мы
будем работать с твипами.
Разместим на форме 4 лейбла для надписей:
Name = lblCaption
Index = 0; 1; 2; 3
Caption = "Максимальная скорость"; "Время"; "Количество попутных авто";
"Количество встречных авто"
Height = 195
Left = 120
Top = 120; 420; 720; 1020
Width = 2295
Добавим два текстовых поля:
Name = txtMaxSpeed
Height = 285
Left = 2520
MaxLength = 3
Text = "300"
Top = 60
Width = 735
Name = txtTime
Height = 285
Left = 2520
MaxLength = 7
Text = "0:01:00"
Top = 360
Width = 735
И два выпадающих списка:
Name = cboNumAuto
Index = 0; 1
Left = 2520
List = 0|1|2|3|4|5|6
Style = 2 – Dropdown List
Top = 660; 960
Width = 795
Ну и наконец две кнопки:
Name = cmdOKCancel
Index = 0; 1
Caption = "ОК"; "Отмена"
Height = 215
Left = 3480
Top = 540; 960
Width = 1155
В форме frmMain сделаем вызов новой формы
Private Sub mnuOptions_Click()
frmOption.Show vbModal
End Sub
Теперь можно попробовать запустить проект.
Шаг 15. Где можно хранить настройки? Вариантов
несколько, но наиболее часто встречаемые это либо в реестре, либо в отдельном
файле (например *.ini). В нашем случае давайте будем сохранять в реестре. В VB
для работы с реестром существует 4 встроенных функции: GetSetting, SaveSetting,
DeleteSetting и GetAllSettings. У них существует один недостаток: они работают
только с одной ветвью реестра – HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program
Settings. В принципе, мы не будем хранить никакой секретной информации типа
пароля, серийного номера и т.п., поэтому нас устроят и эти функции (а вернее,
первые две из них, которые считывают и записывают данные из реестра).
Единственное что мы сделаем – это "обертку" для них, чтобы нам было удобнее
пользоваться. Так как обращаться к реестру мы будем из обеих форм, то нашу
функцию мы должны разместить, естественно, в модуле. Для начала опишем две
нумерованные константы в разделе деклараций модуля.
NB! Нумерованные константы могут принимать только
целочисленные значения.
Public Enum constTypeOptions
GetOption = 0
SaveOption = 1
End Enum
Public Enum constKeyOptions
MaxSpeed = 0
Time = 1
AutoUp = 2
AutoDown = 3
End Enum
Ну а теперь и саму функцию-обертку:
Public Function Options(ByVal TypeOptions As constTypeOptions, ByVal Key As
constKeyOptions, Optional Setting As String) As String
Select Case TypeOptions
Case GetOption 'считывание
Options = GetSetting(App.EXEName, "Options", Key)
Case SaveOption 'запись
SaveSetting App.EXEName, "Options", Key, Setting
End Select
End Function
Теперь давайте попробуем запустить эту функцию в работу.
В самый первый запуск нашей программы мы должны сделать запись в реестр со
значениями по умолчанию. В дальнейшем, через окно настроек мы будем
устанавливать свои параметры. В процедуру Main, в самое начало впишем проверку
на наличие записей о нашей программе в реестре.
Public Sub Main()
Dim i%
If Options(GetOption, Time) = vbNullString Then
Options SaveOption, AutoDown, 6
Options SaveOption, AutoUp, 6
Options SaveOption, MaxSpeed, 300
Options SaveOption, Time, "0:01:00"
End If
...
End Sub
Запустим проект и сразу же закроем. Зайдем в реестр: кнопка
"Пуск" – меню
"Выполнить" – в текстовом поле наберем "regedit" и нажмем ОК.
Откроем ветку HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings. Опустимся
ниже в наш проект: AutoRoad\Options. Если все сделано правильно, то в правом
окне Вы должны увидеть следующие записи: (По умолчанию) – (Значение не
присвоено)
0
– "300"
1
– "0:01:00"
2
– "6"
3
– "6"
Т.е. наши параметры по умолчанию были записаны.
Шаг 16. Перейдем в форму frmMain, и в событии
загрузки формы запишем считывание в лейбл времени.
Private Sub Form_Load()
lblTime.Caption = Options(GetOption, Time)
End Sub
Поставим ограничение максимальной скорости нашего авто:
Private Sub picRoad_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
...
Case vbKeyUp
Speed = Speed + 1
If Speed * 20 > Options(GetOption, MaxSpeed) Then Speed = Options(GetOption,
MaxSpeed) / 20
lblSpeed.Caption = Speed * 20
...
End Select
End Sub
В событии таймера, следящего за временем игры, сделаем
исправление для лейбла времени на окончание игры.
Private Sub tmrTime_Timer()
lblTime.Caption = CDate(CDate(lblTime.Caption) - CDate("0:00:01"))
If lblTime.Caption = "0:00:00" Then
...
lblTime.Caption = Options(GetOption, Time)
Speed = 0
End If
End Sub
Пока на этом закончим и перейдем к ...
Шаг 17. ...форме frmOptions. Эта форма должна при
открытии считать данные реестра и заполнить соответствующие поля, а при выходе
сохранить изменения в реестре.
Private Sub Form_Load()
txtTime.Text = Options(GetOption, Time)
txtMaxSpeed.Text = Options(GetOption, MaxSpeed)
cboNumAuto(0).ListIndex = Options(GetOption, AutoUp)
cboNumAuto(1).ListIndex = Options(GetOption, AutoDown)
End Sub
Private Sub cmdOKCancel_Click(Index As Integer)
Select Case Index
Case 0 'если ОК - сохраняемся в реестре
Options SaveOption, Time, txtTime.Text
Options SaveOption, MaxSpeed, txtMaxSpeed.Text
Options SaveOption, AutoUp, CStr(cboNumAuto(0).ListIndex)
Options SaveOption, AutoDown, CStr(cboNumAuto(1).ListIndex)
End Select
'закрытие формы
Unload Me
End Sub
В случае, если нажимается кнопка Отмены, то происходит просто
выгрузка формы без сохранения данных в реестр.
Теперь можно немного поиграть с окном настроек, выискивая
недостатки.
Шаг 18. Их (недостатков) оказалось не так много,
но они все-таки есть. Если в ComboBox'ах мы особенно-то развернуться
пользователю не даем (можно только выбирать из предложенного), то в текстовых
полях – пиши чего хочешь. На стадии рисования формы мы ограничили количество
вводимых знаков в текстовые поля (свойство MaxLenght), теперь давайте займемся
ограничением ввода тех знаков, которые мы хотим разрешить вводить пользователю.
Очень удобным для этого является событие KeyPress, которое использует ASCII-коды
каждого символа. Мы проверяем вводимый символ и если он допустим – ничего не
делаем, а если нет – не выводим его и выдаем звуковой сигнал.
Private Sub txtMaxSpeed_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 8, 48 To 57 'backspace + цифры от 0 до 9
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub txtTime_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 8, 48 To 57, 58
'backspace + цифры от 0 до 9 + двоеточие
Case Else
Beep
KeyAscii = 0
End Select
End Sub
Теперь проблем с вводом цифр нет и поле Максимальной
скорости работает идеально, а вот с полем времени проблемы еще остались.
Например, мы можем ввести такую запись ":::7755". Давайте ЗАСТАВИМ пользователя
правильно ввести время:
Private Sub cmdOKCancel_Click(Index As Integer)
Select Case Index
Case 0 'если ОК - сохраняемся в реестре
'проверка на правильность введения
времени
If Not IsDate(txtTime.Text) Then
MsgBox "В поле не время!", vbExclamation, "Ошибка!"
Exit Sub
End If
Options SaveOption, Time, txtTime.Text
Options SaveOption, MaxSpeed, txtMaxSpeed.Text
Options SaveOption, AutoUp, CStr(cboNumAuto(0).ListIndex)
Options SaveOption, AutoDown, CStr(cboNumAuto(1).ListIndex)
End Select
'закрытие формы
Unload Me
End Sub
Осталось изменить параметры в форме frmMain при выгрузке
формы frmOptions
Private Sub Form_Unload(Cancel As Integer)
'передача данных в основную форму
frmMain.lblTime.Caption = Options(GetOption, Time)
End Sub
Количеством встречных и попутных авто мы займемся
чуть-чуть позже.
Шаг 19. Итак это "чуть-чуть позже" наступило. Для
начала выведем из процедуры Main в модуле часть кода, для определения случайного
положения машин, в отдельную процедуру и назовем ее RndAuto. А циклы For ...
Next привяжем к данным о количестве машин, хранящихся в реестре. В исправленном
виде обе процедуры должны выглядеть так:
Public Sub Main()
If Options(GetOption, Time) = vbNullString Then
Options SaveOption, AutoDown, 6
Options SaveOption, AutoUp, 6
Options SaveOption, MaxSpeed, 300
Options SaveOption, Time, "0:01:00"
End If
With frmMain
Auto.x = .picRoad.Width * 0.75
RndAuto
.Show
.RedrawPic
End With
End Sub
Public Sub RndAuto()
Dim i%
With frmMain
Randomize
For i = 0 To Options(GetOption, AutoDown) - 1
OtherAuto(i).x = (i * 25) + (.picRoad.Width * 0.05)
OtherAuto(i).y = Int((.picRoad.Height + 1) * Rnd)
Next
For i = 6 To Options(GetOption, AutoUp) + 5
OtherAuto(i).x = ((i - 6) * 25) + (.picRoad.Width * 0.5)
OtherAuto(i).y = Int((.picRoad.Height + 1) * Rnd)
Next
End With
End Sub
В форме Настроек на выходе добавляем процедуру RndAuto и
заставляем основную форму перерисоваться - frmMain.RedrawPic
Private Sub Form_Unload(Cancel As Integer)
With frmMain
.lblTime.Caption = Options(GetOption, Time)
RndAuto
.RedrawPic
End With
End Sub
Осталось немного: сделать исправления в цикле RedrawPic,
относительно настроек реестра
Public Sub RedrawPic()
Dim i%
DrawRoad
DrawAuto
For i = 0 To Options(GetOption, AutoDown) - 1
DrawOtherAuto i
Next
For i = 6 To Options(GetOption, AutoUp) + 5
DrawOtherAuto i
Next
End Sub
и тоже самое в
циклах процедуры tmrMove_Timer:
Private Sub tmrMove_Timer()
Dim i%
For i = 0 To Options(GetOption, AutoDown) - 1
...
Next
For i = 6 To Options(GetOption, AutoUp) + 5
...
Next
...
End Sub
Собственно говоря, на этом написание логики нашей игры
можно считать законченной.
Шаг 20. При желании, можно заняться немного
украшательством. Давайте создадим ActiveX Control, который будет эмулировать
работу спидометра.
NB! ActiveX Control'ы могут существовать в 2-х видах:
как отдельный файл (для многоразового использования в различных программах) и
как составная часть конкретной программы.
Мы воспользуемся встроенным ActivX Control'ом. Меню
Project/Add User Control – добавит его в Ваш проект. Установим некоторые его
свойства:
Name = Speedometr
AutoRedraw = True
BorderStyle = 1 – Fixed Single
DrawStyle = 0 – Solid
FillColor = &H00FFFFC0&
FillStyle = 0 – Solid
ToolboxBitmap – вставьте любую картинку (bmp) 15 х 16 пиксел, какую хотите
увидеть на панели инструментов.
Далее воспользуемся мастером создания ActivX Control'ов.
Для этого выберите меню Add- Ins/Add-Inn Manager ... В открывшемся окне выберите
VB6 ActiveX Ctrl Interface Wizard, а в CheckBox'е "Loaded/Unloaded" – поставьте
галочку и нажмите ОК. Теперь через меню Add-Ins/ActiveX Control Interface Wizard
вызовем непосредственно сам мастер и воспользуемся его пошаговыми услугами.
Step 1. В правом
списке оставим только свойство BackColor.
Step 2. С помощью
кнопки New добавим свои свойства: Min, Max, Value, ArrowColor, ConturColor,
ArrowWidth
Step 3. Здесь мы
сделаем привязку некоторых свойств к свойствам самого UserControl'a:
BackColor –
UserControl.BackColor
ConturColor –
UserControl.FillColor
ArrowWidth –
UserControl.DrawWidth
Step 4. Для
оставшихся свойств выберем значения (Public Name – Data Type – Default Value):
ArrowColor –
OLE_COLOR – 0
Max – Long – 100
Min – Long – 0
Value – Long - 0
Нажмем кнопку ОК. Мастер вчерне сгенерировал нам код.
Сделаем маленькие дополнения, чтобы наш контрол нормально изображал спидометр.
Вначале очистим от предыдущей графики. Следующие две строки служат для
украшательства: они рисуют светлую полоску сверху и полукруг внизу в центре. А
вот последняя строка – основная – она рисует стрелку спидометра (прямая линия) с
началом внизу в центре и концом вверху в точке, зависящей от значения Value
(пересчет производится в единицы, относительно ширины контрола).
Private Sub Draw()
Cls
Line (0, 0)-(ScaleWidth, ScaleHeight * 0.1), ConturColor, BF
Circle (ScaleWidth * 0.5, ScaleHeight), ScaleHeight * 0.1, ConturColor
Line (ScaleWidth * 0.5, ScaleHeight)-(ScaleWidth * (m_Value – m_Min)/ (m_Max
- m_Min), 0), m_ArrowColor
End Sub
Теперь, чтобы эта процедура заработала ее необходимо
вставить в каждое Property Let нашего контрола, примерно так:
Public Property Let Value(ByVal New_Value As Long)
m_Value = New_Value
PropertyChanged "Value"
Draw
End Property
и добавить процедуру, инициализирующую графику при запуске
контрола:
Private Sub UserControl_Show()
Draw
End Sub
Контрол готов.
Шаг 21. Привязываем контрол к форме. В frmMain
внесем изменения в события Form_Load, picRoad_KeyDown, Crash, tmrTime_Timer,
чтобы привязать к изменениям, происходящих с переменной Speed и дублирующих
изменения lblSpeed, только в графическом варианте:
Private Sub Form_Load()
lblTime.Caption = Options(GetOption, Time)
Speedometr1.Max = Options(GetOption, MaxSpeed)
End Sub
Private Sub picRoad_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case& KeyCode
...
Case vbKeyUp
Speed = Speed + 1
If Speed * 20 > Options(GetOption, MaxSpeed) Then Speed = Options(GetOption,
MaxSpeed) / 20
lblSpeed.Caption = Speed * 20
Speedometr1.Value = Speed * 20
Case vbKeyDown
Speed = Speed - 1
If Speed < 0 Then Speed = 0
lblSpeed.Caption = Speed * 20
Speedometr1.Value = Speed * 20
End Select
End Sub
Private Sub Crash()
...
Speed = 0
lblSpeed.Caption = "0"
Speedometr1.Value = 0
...
End Sub
Private Sub tmrTime_Timer()
...
lblTime.Caption = Options(GetOption, Time)
Speedometr1.Value = 0
Speed = 0
End If
End Sub
В frmOption – в событие Form_Unload так же внесем
изменения, которые характеризуют изменения в контроле, а именно его максимальное
значение:
Private Sub Form_Unload(Cancel As Integer)
With frmMain
.lblTime.Caption = Options(GetOption, Time)
.Speedometr1.Max = Options(GetOption, MaxSpeed)
RndAuto
.RedrawPic
End With
End Sub
Заключение. За 21 шаг сделана вполне
функциональная игрушка. У каждого, кто программирует , вполне возможно, появятся
свои идеи, как улучшить данное приложение, чтобы оно стало еще интереснее для
пользователя. Что это будет: улучшение графики или увеличение возможностей
движения авто – решать Вам. Автор данной статьи будет благодарен за присланные
нововведения в вариант этой игрушки.