Code zu Tastatur und Maus in Classic Visual Basic

Ermitteln von Informationen zur Tastatur

Folgender Code gibt Informationen zur verwendeten Tastatur in einem Meldungsfeld aus:

Private Declare Function GetKeyboardType Lib "user32.dll" ( _
    ByVal nTypeFlag As Long _
) As Long

Private Type KeyboardInfo
    Type_ As Long
    SubType As Long
    FunctionKeys As Long
End Type

Private Sub Main()
    Dim ki As KeyboardInfo
    ki = GetKeyboardInfo
    Dim s As String
    s = "Typ:  "
    Select Case ki.Type_
        Case 1: s = s & "IBM PC/XT or compatible (83-key) keyboard"
        Case 2: s = s & "Olivetti ""ICO"" (102-key) keyboard"
        Case 3: s = s & "IBM PC/AT (84-key) or similar keyboard"
        Case 4: s = s & "IBM enhanced (101- or 102-key) keyboard"
        Case 5: s = s & "Nokia 1050 and similar keyboards"
        Case 6: s = s & "Nokia 9140 and similar keyboards"
        Case 7: s = s & "Japanese keyboard"
        Case Else: s = s & "(unknown)"
    End Select
    s = _
        s & vbNewLine & _
        "Untertyp:  " & CStr(ki.SubType) & vbNewLine & _
        "# Function Keys:  " & CStr(ki.FunctionKeys)
    Call MsgBox(s)
End Sub

Private Function GetKeyboardInfo() As KeyboardInfo
    Dim KeyboardType As Long
    
    ' Ermitteln des allgemeinen Tastaturtyps.
    GetKeyboardInfo.Type_ = GetKeyboardType(0)
    
    ' Ermitteln des Untertyps "(The subtype is an original equipment
    ' manufacturer (OEM)-dependent value)".
    GetKeyboardInfo.SubType = GetKeyboardType(1)
    
    ' Anzahl der Funktionstasten ermitteln.
    GetKeyboardInfo.FunctionKeys = GetKeyboardType(2)
End Function

Systemweites Überwachen einer Taste

Mittels eines Timers Timer1 ist es möglich, systemweit auf das Drücken einer Taste der Tastatur zu reagieren. Dieses Beispielprogramm reagiert auf die Eingabetaste und Escape:

Private Declare Function GetAsyncKeyState Lib "user32.dll" ( _
    ByVal vKey As Long _
) As Integer

Private Const KEY_PRESSED As Integer = -32767

Private Const VK_RETURN As Long = &HD&
Private Const VK_ESCAPE As Long = &H1B&

Private Sub Timer1_Timer()
    If GetAsyncKeyState(VK_RETURN) = KEY_PRESSED Then
        Call MsgBox("Die Eingabetaste wurde gedrückt.")
    ElseIf GetAsyncKeyState(VK_ESCAPE) = KEY_PRESSED Then
        Me.Timer1.Enabled = False
        Call Unload(Me)
    End If
End Sub

Ermitteln der vergangenen Zeit seit dem letzten Tastaturereignis

Mittels eines Timers und der Funktion GetAsyncKeyState kann man sehr einfach ermitteln, wie viel Zeit seit dem letzten Tastaturereignis vergangen ist. Dabei werden auch Mausklicks berücksichtigt:

Private Declare Function GetAsyncKeyState Lib "user32.dll" ( _
    ByVal vKey As Long _
) As Integer

Private m_StartTime As Date

Private Sub Form_Load()
    With Me.Timer1
        .Interval = 100
        .Enabled = True
    End With
    Call Timer1_Timer
    
    ' Tastaturpuffer leeren.
    Call IsAnyKeyPressed
    m_StartTime = Now
End Sub

Private Sub Timer1_Timer()
    Dim s As String
    If Not IsAnyKeyPressed Then
        s = CStr(DateDiff("s", m_StartTime, Now))
    Else
        s = "0"
        m_StartTime = Now
    End If
    Me.Caption = s & " Sekunden seit letztem Tastendruck"
End Sub

Private Function IsAnyKeyPressed() As Boolean
    Dim i As Long
    For i = 0 To 255
        If GetAsyncKeyState(i) <> 0 Then
            IsAnyKeyPressed = True
            Exit For
        End If
    Next i
End Function

Vertauschen der Funktion der Maustasten

Die API-Funktion SwapMouseButton dient zum Tauschen der Funktion von rechter und linker Maustaste. Im folgenden Beispiel kann in einer CheckBox eingestellt werden, ob die Funktion der beiden Tasten vertauscht werden soll. Beim Beenden des Programms sollte man nach Möglichkeit die Einstellung wieder zurücksetzen:

Private Declare Function SwapMouseButton Lib "user32.dll" ( _
    ByVal bSwap As Long _
) As Long

Private Const API_TRUE As Long = 1&
Private Const API_FALSE As Long = 0&

Private Sub chkSwapped_Click()
    Call SwapMouseButton( _
        IIf( _
            Me.chkSwapped.Value = vbChecked, _
            API_TRUE, _
            API_FALSE _
        ) _
    )
End Sub

Anzeigen der gedrückten Tasten

Durch Setzen der KeyPreview-Eigenschaft auf True können Tastatureingaben aller Steuerelemente am Formular überwacht werden. Im folgenden Beispiel werden diese Tasten durch Zeichen in der Titelleiste eines Formulars visualisiert:

Private m_KeyMem As String
Private m_LastKey As Long

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode <> m_LastKey Then
        m_KeyMem = m_KeyMem & Chr$(KeyCode)
    End If
    m_LastKey = KeyCode
    Me.Caption = m_KeyMem
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim n As Long
    n = InStr(1, m_KeyMem, Chr$(KeyCode))
    If n > 0 Then
        m_KeyMem = _
            Left$(m_KeyMem, n - 1) & _
            Mid$(m_KeyMem, n + 1)
        Me.Caption = m_KeyMem
    End If
    If KeyCode = m_LastKey Then
        m_LastKey = -1
    End If
End Sub

Private Sub Form_Load()
    Me.KeyPreview = True
End Sub

Mauszeiger absolut zu einem bestimmten Steuerelement plazieren

Die Prozedur SetMousePosition setzt den Mauszeiger an die in den Parametern x und y zu ReferenceObject absolute Position. Als Skalierungsmodus müssen Pixel verwendet werden:

Private Declare Function ClientToScreen Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByRef lpPoint As POINTAPI _
) As Long

Private Declare Function SetCursorPos Lib "user32.dll" ( _
    ByVal x As Long, _
    ByVal y As Long _
) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Sub SetCursorPosition( _
    ByVal ReferenceObject As Object, _
    ByVal x As Long, _
    ByVal y As Long _
)
    Dim Position As POINTAPI
    Position.x = x
    Position.y = y
    Call ClientToScreen(ReferenceObject.hWnd, Position)
    Call SetCursorPos(Position.x, Position.y)
End Sub

Private Sub cmdMove_Click()
    With Me.Shape1
        Call SetCursorPosition( _
            Me, _
            .Left + .Width * 0.5, _
            .Top + .Height * 0.5 _
        )
    End With
End Sub

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub

Deaktivieren der Tastenkombination Strg+Alt+Entf

Die im Folgenden angegebene Funktion CtrlAltDel kann dazu verwendet werden, die Tastenkombination Strg+Alt+Entf zu deaktivieren bzw. wieder zu aktivieren. Dieses Beispiel funktioniert nicht unter Windows NT, 2000 und XP:

Private Declare Function SystemParametersInfo _
    Lib "user32.dll" _
    Alias "SystemParametersInfoA" _
( _
    ByVal uAction As Long, _
    ByVal uParam As Long, _
    ByRef lpvParam As Long, _
    ByVal fuWinIni As Long _
) As Long

Private Const SPI_SCREENSAVERRUNNING As Long = 97&

'
' Setzt den Status von 'SPI_SCREENSAVERRUNNING' und gibt den
' vorhergehenden Status zurück.
'
Private Function CtrlAltDel(ByVal Enabled As Boolean) As Boolean
    Dim Old As Long
    Call SystemParametersInfo( _
        SPI_SCREENSAVERRUNNING, _
        CLng(IIf(Enabled, 1&, 0&)), _
        Old, _
        0& _
    )
    CtrlAltDel = (Old <> 0&)
End Function

Überwachen der absoluten Position des Mauszeigers

Damit folgendes Beispiel zum Ermitteln der globalen Mauskoordinaten (vom Ursprung links oben am Bildschirm) funktioniert, muß ein Timer-Steuerelement mit dem Namen Timer1 verwendet werden, das als Intervall beispielsweise 50 Millisekunden verwendet:

Private Declare Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI _
) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private m_pt As POINTAPI

Private Sub Timer1_Timer()
    Call GetCursorPos(m_pt)
    Debug.Print "x: " & CStr(m_pt.x) & ", y: " & CStr(m_pt.y)
End Sub

Blockieren von Tastatur und Maus

Das Windows-API stellt eine Funktion zum Blockieren von Tastatur und Maus zur Verfügung. Während der Blockierung reagieren die Maus und die Tastatur nicht. Diese API-Funktion wird nur auf neueren Versionen von Windows unterstützt. Wie aus der Funktionsdeklaration ersichtlich, erwartet BlockInput im Parameter fBlock einen Wert vom Typ BOOL. Unter Visual Basic können daher keine Werte des Typs Boolean verwendet werden. Nachstehendes Listing zeigt die Deklaration der Funktion BlockInput und Beispielaufrufe:

Private Declare Function BlockInput Lib "user32.dll" ( _
    ByVal fBlock As Long _
) As Long

Private Const API_TRUE As Long = 1&
Private Const API_FALSE As Long = 0&

⋮

Call BlockInput(API_TRUE)
⋮
Call BlockInput(API_FALSE)

Aufruf von DoEvents nur bei Bedarf

Man sollte DoEvents nicht öfter als unbedingt nötig aufrufen, insbesondere in zeitkritischen Schleifen. Üblicherweise wird daher DoEvents alle n Schleifendurchgänge aufgerufen, z. B. wie hier alle 10 Mal:

Dim i As Long
For i = 1 To 10000
    ⋮
    If (i Mod 10) = 0 Then
        DoEvents
    End If
Next i

Wird DoEvents aufgerufen, um eventuell vorhandene Maus- und Tastaturereignisse abarbeiten zu lassen, sollte man mit der API-Funktion GetInputState abfragen, ob überhaupt solche Ereignisse vorliegen:

Private Declare Function GetInputState Lib "user32.dll" ( _
) As Long

Private Sub ProcessEvents()
    If GetInputState <> 0& Then
        DoEvents
    End If
End Sub

Der Aufruf könnte folgendermassen erfolgen:

Dim i As Long
For i = 1 To 10000
    ⋮
    Call ProcessEvents
Next i

Etwas mehr Kontrolle über den Typ der Nachrichten, die auf ihre Verarbeitung warten, bietet die Funktion GetQueueStatus. Die Prozedur ProcessEvents dient als Ersatz für DoEvents. Wird sie ohne Parameter aufgerufen, wird DoEvents beim Vorliegen beliebiger Nachrichten ausgeführt, sonst nur dann, wenn Nachrichten bestimmter Typen auf ihre Verarbeitung warten:

Private Declare Function GetQueueStatus Lib "user32.dll" ( _
    ByVal fuFlags As Long _
) As Long

Private Const QS_HOTKEY As Long = &H80&
Private Const QS_KEY As Long = &H1&
Private Const QS_MOUSEBUTTON As Long = &H4&
Private Const QS_MOUSEMOVE As Long = &H2&
Private Const QS_PAINT As Long = &H20&
Private Const QS_POSTMESSAGE As Long = &H8&
Private Const QS_SENDMESSAGE As Long = &H40&
Private Const QS_TIMER As Long = &H10&
Private Const QS_ALLPOSTMESSAGE As Long = &H100&
Private Const QS_MOUSE As Long = QS_MOUSEMOVE Or QS_MOUSEBUTTON
Private Const QS_INPUT As Long = QS_MOUSE Or QS_KEY
Private Const QS_ALLEVENTS As Long = _
    QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY
Private Const QS_ALLINPUT As Long = _
    QS_SENDMESSAGE Or _
    QS_PAINT Or _
    QS_TIMER Or _
    QS_POSTMESSAGE Or _
    QS_MOUSEBUTTON Or _
    QS_MOUSEMOVE Or _
    QS_HOTKEY Or _
    QS_KEY

Private Sub ProcessEvents(Optional ByVal Events As Long = QS_ALLINPUT)
    If GetQueueStatus(Events) <> 0& Then
        DoEvents
    End If
End Sub