Статьи

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

Первая статья, посвященная написанию игрушки на VB , без DirectX и прочих "наворотов", вызвала в мой адрес шквал писем. Сейчас ажиотаж прошел, но письма продолжают приходить. Да бейсик "тяжеловат" для создания игрушек, но это не повод еще от него отказываться. Хочу предложить Вашему вниманию новую игрушку, которая комбинирует в себе API-функции и возможности самого бейсика. Игрушка относится к категории "стрелялок", поэтому создав новый проект, дадим ему название Shooting.

Произведем изменения параметров формы: Name = frmMain, AutoRedraw = True, BorderStyle = 1, Caption = "Shooting", Font = "Times New Roman", 48, Bold, ForeColor = &H0000FFFF& (vbYellow), MousePointer = 2 (Cross), ScaleMode = 3 (Pixel). Иконку установите по своему вкусу, а для картинки будем использовать формат JPG, что-нибудь с видом кирпичной стены, дерева, или другое, что-то в этом роде.

Начнем с самого неприятного - с промахов :)
Мы должны спроецировать изображение дырки от выстрела на стену. Если бы это было на гладком фоне - то проблем не возникает. Просто рисуем bmp с фоном соответствующего цвета и копируем, ну допустим, с помощью BitBlt на форму. Однако, фоном у нас является картинка - следовательно, мы должны скопировать ее на форму с прозрачным фоном. Для этого существует еще одна API-функция TransparentBlt, которой мы и воспользуемся

NB! Функция TransparentBlt входит в состав библиотеки msimg32.dll, которая отсутствует в Windows 95. Поэтому "счастливым" обладателям этой уже устаревшей системы прежде необходимо скопировать этот файл в Windows\System.

Объявим в разделе деклараций данную API-функцию:
Private Declare Function TransparentBlt Lib "msimg32.dll" _
    (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 crTransparent As Long) _
    As Boolean

Нарисуем в любом редакторе картинку, изображающую дырку от выстрела с белым фоном и разместим ее на форме в Image (Name = picShoot). А в событии Form_MouseDown - применим функцию копирования, относительно координат курсора:
Private Sub Form_MouseDown(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)

    DoEvents
    TransparentBlt hdc, X - picShoot.ScaleWidth / 2, _
    Y - picShoot.ScaleHeight / 2, picShoot.ScaleWidth, _
    picShoot.ScaleHeight, picShoot.hdc, 0, 0, _
    picShoot.ScaleWidth, picShoot.ScaleHeight, vbWhite

    Refresh
End Sub

Теперь можно попробовать. Запустите программу и пощелкайте мышкой по экрану.

Ну что ж, займемся "жертвами". В нашем случае это будут тараканы, жуки, пауки и прочая нечисть. Составим "техническое задание". Наши жертвы должны появляться в случайных местах экрана, через определенный интервал времени, и разных видов.
Начнем с последнего. Добавим на форму 5 Image (Name = imgBug, Index от 0 до 4) и разместим в них 5 различных иконок с жуками (*.ico). Чего мы добиваемся этим? А все очень просто: иконки-то уже содержат элемент прозрачности, следовательно, половина забот долой.
Добавим еще один Image (Name = imgTarget, Visible = False). Именно он у нас и будет объектом расстрела. В него мы будем с определенным интервалом времени загружать случайные иконки. А раз заговорили о времени, то, естественно, его надо отслеживать. Расположим на форме два таймера. Первый у рас будет следить за выводом картинок (Name = tmrBug, Interval = 1000, Enabled = False), а второй - за временем игры (Name = tmrTime, Interval = 1000, Enabled = False).
С помощью генератора случайных чисел (не забыли формулу?
Int((МаксимальноеЗначение - МинимальноеЗначение + 1) * Rnd + МинимальноеЗначение)
) делаем смену картинок и выбираем случайную позицию для "жертвы":
Private Sub tmrBug_Timer()
    Dim lX&, lY&, iBug%
    Randomize
    iBug = Int(5 * Rnd)
    imgTarget.Picture = imgBug(iBug).Picture
    lX = Int((ScaleWidth - imgTarget.Width + 1) * Rnd)
    lY = Int((ScaleHeight - picStatus.Height - imgTarget.Height + 1) * Rnd)
    imgTarget.Move lX, lY
End Sub

Для отслеживания и отображения времени нам еще понадобится статусная строка. Для нее используем PictureBox (Name = picStatus, Align = 2, AutoRedraw = True) и пара переменных уровня формы:
Private dTime As Date
Private iHit As Integer

Private Sub tmrTime_Timer()
    picStatus.Cls
    dTime = dTime - CDate("0:00:01")
    If dTime <= CDate("0:00:00") Then
        tmrTime.Enabled = False
        tmrBug.Enabled = False
        imgTarget.Visible = False
    End If
    picStatus.Print dTime & " Hit: " & iHit
End Sub

Все прекрасно: есть, кто отслеживает время и останавливает игру по его окончании (мы для примера взяли интервал в 1 минуту). А вот кто будет запускать все это? Давайте для этого использовать стандартное меню (Name = mnuPlay, Caption = "Play") и подменю:
Name = mnuNew, Caption = "New", Shortcut = F2
Name = mnuSep, Caption = "-", Shortcut = F2
Name = mnuExit, Caption = "Exit", Shortcut = F12

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuNew_Click()
    Cls
    dTime = CDate("0:01:00")
    iHit = 0
    tmrTime.Enabled = True
    tmrBug.Enabled = True
    imgTarget.Visible = True
End Sub

Можно запустить пробу и поиграться. Так... Жуки появляются и исчезают, с промахами тоже все нормально :))) А вот с попаданиями дело обсьоит гораздо хуже. То есть попадать-то попадаем, но эффекта от этого нет. Добавим на форму последний элемент. Это снова будет Image, на этот раз с иконкой, изображающей, что получится от жука при попадании :))) Имя ей дадим imgExplosion. И теперь, при попадании на основной имидж будем менять в нем картинку, а кроме того наращивать число попаданий (переменная iHit).
Private Sub imgTarget_MouseDown(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)

    imgTarget.Picture = imgExplosion.Picture
    imgTarget.Refresh
    iHit = iHit + 1
End Sub

Итак, в черновике игрушка сделана. Осталось добавить несколько штрихов-украшений, чем мы сейчас и займемся. Ну во-первых, неплохо бы было выводить надпись об окончании игры. Сделаем это прямо на форме и разместим в процедуре отслеживания времени игры:
Private Sub tmrTime_Timer()
    ...
    If dTime <= CDate("0:00:00") Then
        ...
        CurrentX = (ScaleWidth - TextWidth("Finish")) / 2
        CurrentY = (ScaleHeight - TextHeight("Finish")) / 2
        Print "Finish"
    End If
    ...
End Sub

А во-вторых, неплохо бы было озвучить и попадания и промахи. Для этого воспользуемся еще одной API-функцией, которую необходимо разместить в разделе деклараций:
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000
Private Declare Function PlaySound Lib "winmm.dll" _
    Alias "PlaySoundA" _
    (ByVal lpszName As String, _
    ByVal hModule As Long, _
    ByVal dwFlags As Long) _
    As Long

Ну а использование этой функции особого труда не представляет:
Private Sub Form_MouseDown(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)

    PlaySound App.Path & "\RICOCHET.WAV", ByVal 0&, SND_FILENAME Or SND_ASYNC
    ...
End Sub

Private Sub imgTarget_MouseDown(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)

    PlaySound App.Path & "\GUN_SHOT.WAV", ByVal 0&, SND_FILENAME Or SND_ASYNC
    ...
End Sub

Что можно сказать в заключение? Мы получили вполне работоспособную игрушку (и надеюсь интересную) с минимальной потерей времени и сил + потратив на это чуть-чуть фантазии. Да, конечно, ее можно усложнить. Например добавив окно настроек (времени игры, времени выстрела и т.п.), а так же таблицу рекордов, добавить анимацию жуков. Чем и предлагаю заняться ВАМ :-)))

Скачать пример