Многопоточность в 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д