Как написать игрушку на VB

загрузить пример

Каждый программист в своей жизни написал хотя бы одну игрушку. Не являются исключением из этого правила и те, кто пишет на 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 шаг сделана вполне функциональная игрушка. У каждого, кто программирует , вполне возможно, появятся свои идеи, как улучшить данное приложение, чтобы оно стало еще интереснее для пользователя. Что это будет: улучшение графики или увеличение возможностей движения авто – решать Вам. Автор данной статьи будет благодарен за присланные нововведения в вариант этой игрушки.

 

 

Автор: Этот e-mail адрес защищен от спам-ботов, для его просмотра у Вас должен быть включен Javascript
Источник: http://www.vbnet.ru