15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


Как узнать состояние клавиш в любое время

Если Вы создаёте интерактивное приложение или игрушку, использующую DirectX или GDI, то ассинхронное считывание состояния клавиш работает быстрее, чем ожидание событий KeyUp, KeyDown или KeyPress на форме.

Создайте новый проект и добавьте на форму Picture Box и Command Button. Затем поместите следующий код в форму:


Private m_bPlay As Boolean
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub cmdPlay_Click()
Dim i As Long
Dim iLast As Long

    If cmdPlay.Caption = "&Stop" Then
        m_bPlay = False
        cmdPlay.Caption = "&Play"
    Else
        cmdPlay.Caption = "&Stop"
        m_bPlay = True
        i = 1
        Do
           
' Определяем, были ли нажаты правая или левая стрелки:
            If (GetAsyncKeyState(vbKeyLeft)) Then
               
' Уменьшаем цвет
                i = i - 1
            ElseIf (GetAsyncKeyState(vbKeyRight)) Then
               
' Увеличиваем цвет
                i = i + 1
            End If
           
           
' Colour within bounds:
            If (i < 1) Then i = 15
            If (i > 15) Then i = 1
           
           
' If colour has changed, change the display:
            If (iLast <> i) Then
                With Picture1
                    .Cls
                    .ForeColor = QBColor(i)
                   
' Generate a RGB complement for the background:
                    .BackColor = &HFFFFFF And (Not QBColor(i))
                    .CurrentX = 64 * Screen.TwipsPerPixelX
                    .CurrentY = 64 * Screen.TwipsPerPixelY
                   
                    Picture1.Print Hex$(QBColor(i))
                End With
            End If
            iLast = i
           
           
' This is here to stop the animation
            ' getting too fast to see:
            Sleep 25
           
' Ensure we can still click buttons etc
            DoEvents
           
        Loop While m_bPlay
           
    End If
   
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If (cmdPlay.Caption = "&Stop") Then
        cmdPlay_Click
    End If
End Sub

Когда Вы кликните на кнопке (command button), то код запустит цикл DoEvents, в котором будет проверяться нажатия клавишь стрелок: правой и левой. Когда какая либо из них нажата, то изменится фоновый и передний цвета Picture Box и покажется код QBColor.