Rubrik: Maus & Tastatur · Tastatursteuerung | VB-Versionen: VB4, VB5, VB6 | 03.05.04 |
Mehrere HotKeys systemweit registrieren und abfragen Mit diesem Code lassen sich mehrere beliebige HotKeys (Tastenkombinationen) systemweit registrieren und abfragen. | ||
Autor: Dieter Otter | Bewertung: | Views: 19.977 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
In letzter Zeit wurde im Forum verstärkt danach gefragt, wie man mehrere HotKeys (Tastenkombinationen) systemweit registrieren und abfragen kann. Benötigt man nur einen einzigen HotKey, lässt sich folgender Code verwenden:
Hotkey systemweit registrieren und abfragen
Wie lassen sich jetzt aber mehrere HotKeys gleichzeitig erstellen?
Hierzu folgende Überlegung:
- Wir speichern die eindeutige HotKey-ID in ein Collection-Objekt
- Hierzu erstellen wir zunächst ein Klassenmodul zur "Verwaltung" unserer HotKeys
- Wird der HotKey gedrückt, wird unsere HotKeyWndProc-Funktion ausgeführt, in der wir den HotKey anhand seiner ID ermitteln und somit gezielt auswerten können
- Über eine separate Funktion "DeleteHotKey" möchten wir einen registrierten HotKey jederzeit wieder löschen
- Beim Beenden des Programms müssen alle HotKeys autom. gelöscht werden (DeleteAllHotKeys)
Schreiten wir zur Tat: Erstellen Sie ein neues Projekt und fügen diesem ein Klassenmodul mit folgendem Code hinzu (benennen Sie das Klassenmodul clsHotKey):
Option Explicit ' Eigenschaften der Klasse (Members) Private m_KeyCode As VBRUN.KeyCodeConstants Private m_Shift As hkShiftConstants Private m_ID As Long
Public Property Get KeyCode() As VBRUN.KeyCodeConstants KeyCode = m_KeyCode End Property Public Property Let KeyCode(ByVal nKeyCode As VBRUN.KeyCodeConstants) m_KeyCode = nKeyCode End Property
Public Property Get Shift() As hkShiftConstants Shift = m_Shift End Property Public Property Let Shift(ByVal nShift As hkShiftConstants) m_Shift = nShift End Property
Public Property Get ID() As Long ID = m_ID End Property Public Property Let ID(ByVal nID As Long) m_ID = nID End Property
Jetzt benötigen wir noch ein Modul mit folgendem Code:
Option Explicit ' Benötigte API-Konstanten Private Declare Function RegisterHotKey Lib "user32" ( _ ByVal hWnd As Long, _ ByVal ID As Long, _ ByVal fsModifiers As Long, _ ByVal vk As Long) As Long Private Declare Function UnregisterHotKey Lib "user32" ( _ ByVal hWnd As Long, _ ByVal ID As Long) As Long Private Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProc Lib "user32" _ Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Private Declare Function SetForegroundWindow Lib "user32" ( _ ByVal hwnd As Long) As Long Private PrevWndProc As Long Private oHotKeys As New Collection Public Enum hkShiftConstants KeyALT = &H1 KeyCONTROL = &H2 KeySHIFT = &H4 End Enum Public Const WM_HOTKEY = &H312 Public Const GWL_WNDPROC = (-4)
' Neuen HotKey erstellen Public Function DefineHotKey(ByVal hWnd As Long, _ ByVal nKeyCode As VBRUN.KeyCodeConstants, _ Optional ByVal nShift As hkShiftConstants = 0) As Boolean Dim nID As Long Dim cKey As clsHotkey ' eindeutige ID generieren Randomize -Timer Do nID = Int(65535 * Rnd + 1) If oHotKeys.Count > 0 Then On Error Resume Next Set cKey = oHotKeys("id_" + CStr(nID)) If Err.Number <> 0 Then Exit Do Else Exit Do End If Loop On Error GoTo 0 ' HotKey systemweit registrieren... If RegisterHotKey(hWnd, nID, nShift, nKeyCode) <> 0 Then ' ... und in Collection einfügen Set cKey = New clsHotkey With cKey .KeyCode = nKeyCode .Shift = nShift .ID = nID End With oHotKeys.Add cKey, "id_" & CStr(nID) DefineHotKey = True ' Original-Fensterprozedur umleiten If oHotKeys.Count = 1 Then PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf HotkeyWndProc) End If End If End Function
Public Function HotkeyWndProc(ByVal hWnd As Long, _ ByVal uMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long If uMsg = WM_HOTKEY Then ' HotKey aus Collection bestimmen Dim cKey As clsHotkey On Error Resume Next Set cKey = oHotKeys("id_" & CStr(wParam)) If Err.Number = 0 Then On Error GoTo 0 ' ------------------------------------------------ ' Hier werden die registrierten HotKeys abgefragt! ' ------------------------------------------------ With cKey ' Strg+F12 If .KeyCode = vbKeyF12 And .Shift = KeyCONTROL Then ' Eigene Anwendung in den Vordergrund bringen SetForegroundWindow hwnd MsgBox "Strg+F12" ' F11 ElseIf .KeyCode = vbKeyF11 Then ' Eigene Anwendung in den Vordergrund bringen SetForegroundWindow hwnd MsgBox "F11" End If End With End If On Error GoTo 0 End If ' WndProc aufrufen und Rückgabewert durchreichen HotkeyWndProc = CallWindowProc(PrevWndProc, hWnd, uMsg, wParam, lParam) End Function
' HotKey löschen Public Function DeleteHotKey(ByVal hWnd As Long, _ ByVal nKeyCode As VBRUN.KeyCodeConstants, _ ByVal nShift As hkShiftConstants) As Boolean Dim i As Long Dim cKey As clsHotkey For i = 1 To oHotKeys.Count Set cKey = oHotKeys(i) If cKey.KeyCode = nKeyCode And cKey.Shift = nShift Then ' HotKey deregistrieren If UnregisterHotKey(hWnd, cKey.ID) <> 0 Then If oHotKeys.Count = 1 Then ' Original-Fensterprozedur wiederherstellen Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc) End If ' HotKey aus Collection entfernen oHotKeys.Remove i DeleteHotKey = True End If Exit For End If Next i End Function
' Alle HotKeys wieder entfernen Public Function DeleteAllHotKeys(ByVal hWnd As Long) As Boolean Dim i As Long DeleteAllHotKeys = True Do While oHotKeys.Count > 0 i = oHotKeys.Count If Not DeleteHotKey(hWnd, oHotKeys(i).KeyCode, oHotKeys(i).Shift) Then DeleteAllHotKeys = False Exit Do End If Loop End Function
Jetzt brauchen wir die gewünschten HotKeys nur noch festzulegen. Fügen Sie folgenden Code in den Codeteil der Form1 ein:
Option Explicit Private Sub Form_Load() ' 1. HotKey erstellen: STRG+F12 DefineHotKey Me.hWnd, vbKeyF12, KeyCONTROL ' 2. HotKey erstellen: F11 DefineHotKey Me.hWnd, vbKeyF11 End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Wichtig! Alle HotKeys löschen DeleteAllHotKeys Me.hWnd End Sub
Starten Sie das Projekt. Wann immer die Taste F11 oder die Tastenkombination Strg+F12 gedrückt wird, registriert Ihre Anwendung das und blendet eine entsprechende MsgBox ein.