Многопоточность в Visual Basic 6 - VB

Узнай цену своей работы

Формулировка задачи:

Всем доброго времени суток. При написании игры в Visual Basic 6 столкнулся с проблемой. Есть объект который движется по форме при нажатии на стрелки и стреляет при нажатии на клавишу пробела. Проблема в том, что двигаться и стрелять одновременно он не может: если зажать клавишу движения и затем нажать пробел, объект останавливается и начинает стрелять, если же зажать пробел и нажать стрелку, объект движется и не стреляет. Одновременно ни как не получается. Кто-нибудь может подсказать, как справиться с данным ограничением? Правильно ли я понимаю, что её решение связано с реализацией многопоточности? К сожалению, очень мало знаю об этом.

Решение задачи: «Многопоточность в Visual Basic 6»

textual
Листинг программы
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Dim fX As Single, fY As Single 'позиция ввода
Dim fW As Single, fH As Single 'ширина/высота картинки
Dim Bullet() As Boolean 'если снаряд взорван, в элементе массива с его индексом - false, если снаряд ещё летит - true
Dim n1 As Boolean
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
     Select Case KeyCode
     Case 32 And n1 = True 'выстрел
     For i = 1 To UBound(Bullet)         'массив проверяется на наличие свободных ячеек
            If Bullet(i) = False Then       'если найдена свободная ячейка
                Load Shape(i)               'создаётся снаряд с соответствующим индексом
                Shape(i).Visible = True
                Bullet(i) = True            'ячейка помечается как занятая
                n1 = False
                Exit Sub                    ' процедура заканчивает работу
            End If
        Next
        Load Shape(UBound(Bullet) + 1)                          'если все ячейки массива заняты, создаётся снаряд с номером
        Shape(UBound(Bullet) + 1).Visible = True                ' наибольший индекс в массиве + 1
        ReDim Preserve Bullet(UBound(Bullet) + 1) As Boolean    ' размер массива возрастает на 1
        Bullet(UBound(Bullet)) = True                           ' новая ячейка помечается как занятая
        n1 = False
    Case 37 'движение влево
        fX = fX - 10 'движение корабля
        Form1.Cls
        BitBlt Form1.hDC, fX, fY, fW, fH, LeftPictMask.hDC, 0, 0, vbMergePaint
        BitBlt Form1.hDC, fX, fY, fW, fH, LeftPict.hDC, 0, 0, vbSrcAnd
        Shape(0).Left = fX + Picture1.Width / 2 - 4
    Case 38 'движение вверх
        fY = fY - 10 'движение корабля
        Form1.Cls
        BitBlt Form1.hDC, fX, fY, fW, fH, ForwPictMask.hDC, 0, 0, vbMergePaint
        BitBlt Form1.hDC, fX, fY, fW, fH, ForwPict.hDC, 0, 0, vbSrcAnd
        Shape(0).Top = fY
    Case 39 'движение вправо
        fX = fX + 10 'движение корабля
        Form1.Cls
        BitBlt Form1.hDC, fX, fY, fW, fH, RightPictMask.hDC, 0, 0, vbMergePaint
        BitBlt Form1.hDC, fX, fY, fW, fH, RightPict.hDC, 0, 0, vbSrcAnd
        Shape(0).Left = fX + Picture1.Width / 2 - 4
    Case 40 'движение назад
        fY = fY + 10 'движение корабля
        Form1.Cls
        BitBlt Form1.hDC, fX, fY, fW, fH, Picture2.hDC, 0, 0, vbMergePaint
        BitBlt Form1.hDC, fX, fY, fW, fH, Picture1.hDC, 0, 0, vbSrcAnd
        Shape(0).Top = fY
    End Select
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode >= 37 And KeyCode <= 40 Then 'выравнивание звездолёта
        Form1.Cls
        BitBlt Form1.hDC, fX, fY, fW, fH, Picture2.hDC, 0, 0, vbMergePaint
        BitBlt Form1.hDC, fX, fY, fW, fH, Picture1.hDC, 0, 0, vbSrcAnd
    End If
End Sub
 
Private Sub Form_Load()
  'устанавливаем размер рисуемой картинки в зависимости от размера первой картинки
  fW = Picture1.Width
   fH = Picture1.Height
   'забиваем данные в fX и fY, чтобы картинка была по центру формы
  fX = Round((Form1.ScaleWidth - Picture1.Width) / 2)
  fY = Round((Form1.ScaleHeight - Picture1.Height) / 2)
  BitBlt Form1.hDC, fX, fY, fW, fH, Picture2.hDC, 0, 0, vbMergePaint  'Затем картинку
  BitBlt Form1.hDC, fX, fY, fW, fH, Picture1.hDC, 0, 0, vbSrcAnd
  ReDim Bullet(1)
  n1 = True
  Shape(0).Top = fY
  Shape(0).Left = fX + Picture1.Width / 2 - 4
End Sub
 
Private Sub Timer1_Timer()                      'проверяются все элементы массива Bullet
    For i = 1 To UBound(Bullet)
        If Bullet(i) = True Then                'если элемент = true (то есть, снаряд с соответствующим индексом существует)
            Shape(i).Top = Shape(i).Top - 20    'снаряд летит вперёд
            If Shape(i).Top <= 0 Then Vzriv i   'когда снаряд достигает верхнего края вызывается процедура Vzriv с индексом снаряда
        End If
    Next
    If ProvArr1 = False Then ReDim Bullet(1)    'если все снаряды взорваны, массив сжимается до 2 элементов
End Sub
             
Sub Vzriv(i As Variant)
    Unload Shape(i)     'снаряд уничтожается
    Bullet(i) = False   'соответствующая ячейка массива = 0
End Sub
 
Private Function ProvArr1() As Boolean 'если все снаряды взорваны, массив сжимается до 2 элементов
    For i = 1 To UBound(Bullet)
        If Bullet(i) = True Then ProvArr1 = True: Exit Function
    Next
    ProvArr1 = False
End Function
 
Private Sub Timer2_Timer()   'контролирует частоту выстрелов
    If n1 = False Then n1 = True
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 4.182 из 5
Похожие ответы