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 GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" ( _
ByVal lpString As String) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As _
Integer) As Integer
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg _
As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As _
Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal _
  hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
  ByVal cy As Long, ByVal wFlags As Long) As Long
 
 
 
Private Type POINTAPI
   x As Long
   y As Long
End Type
 
Private Type Msg
   hwnd As Long
   Message As Long
   wParam As Long
   lParam As Long
   time As Long
   pt As POINTAPI
End Type
 
'RegisterHotKey fsModifiers-Konstanten
Private Const MOD_ALT = &H1 'Alt-Taste
Private Const MOD_SHIFT = &H4 'Shift-Taste
Private Const MOD_CONTROL = &H2 'STRG-Taste
Private Const MOD_WIN = &H8 'Windows-Taste
 
'Einige Standard Fensternachrichten
Private Const WM_HOTKEY = &H312 'Hotkey wird übermittelt
Private Const WM_NCLBUTTONDOWN = &HA1 'Linksklick im Nicht-Client bereich ( 
' Beenden Button in der Titelleiste)
 
'PeekMessage wRemoveMsg-Konstanten
Private Const PM_NOREMOVE = &H0 'Nachricht soll nicht an das Fenster gesendet 
' werden
Private Const PM_NOYIELD = &H2 'Befreit wartende Threads vom Wartestatus wenn 
' es mit einem der PM-Flags Kombiniert wird
Private Const PM_REMOVE = &H1 'Nachricht soll an das Fenster gesendet werden
 
'einige SetWindowPos-Konstanten
Private Const HWND_TOP = 0 'In den Vordergrund bringen
Private Const SWP_NOMOVE = &H2 'Nicht bewegen
Private Const SWP_NOSIZE = &H1 'Nicht in der Größe verändern
Private Const SWP_SHOWWINDOW = &H40 'Fenster anzeigen
 
Dim hAtom As Long, ExitForm As Boolean
 
'Benötigte Deklarationen
Private Declare Sub mouse_event Lib "user32" _
 (ByVal dwFlags As Long, ByVal dx As Long, _
 ByVal dy As Long, ByVal cButtons As Long, _
 ByVal dwExtraInfo As Long)
 
Const MOUSE_LEFT = 0
Const MOUSE_MIDDLE = 1
Const MOUSE_RIGHT = 2
 
'Die nachfolgende Prozedur simuliert den gewünschten Mausklick.
Public Sub SendMausklick(ByVal mButton As Long)
  Const MOUSEEVENTF_LEFTDOWN = &H2
  Const MOUSEEVENTF_LEFTUP = &H4
  Const MOUSEEVENTF_MIDDLEDOWN = &H20
  Const MOUSEEVENTF_MIDDLEUP = &H40
  Const MOUSEEVENTF_RIGHTDOWN = &H8
  Const MOUSEEVENTF_RIGHTUP = &H10
 
  If (mButton = MOUSE_LEFT) Then
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
  ElseIf (mButton = MOUSE_MIDDLE) Then
    Call mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
  Else
    Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
  End If
End Sub
 
 
'Hotkey Registrieren
Private Sub Form_Load()
   Dim Retval As Long
 
   'Eindeutigen ID erzeugen
   hAtom = GlobalAddAtom("Hotkey_Beispiel")
 
   'Hotkey Registrieren
   Retval = RegisterHotKey(Me.hwnd, hAtom, MOD_CONTROL, Asc(UCase("M")))
   If Retval = 0 Then
      MsgBox "Registrieren des Hotkeys Fehlgeschlagen"
      Call GlobalDeleteAtom(hAtom)
   End If
End Sub
 
 
 
'Auf Hotkey warten
Private Sub Form_Activate()
   Dim wMsg As Msg, Retval As Long
 
   wMsg.hwnd = Me.hwnd
   Do
      DoEvents
 
      'Auf eine Nachricht warten
      Call WaitMessage
 
      'War es die WM_HOTKEY-Nachricht ?
      Retval = PeekMessage(wMsg, Me.hwnd, 0&, 0&, PM_NOREMOVE)
 
      'Nachricht auswerten
      With wMsg
         If .Message = WM_HOTKEY Then
            Call SetWindowPos(Me.hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or _
              SWP_NOSIZE Or SWP_SHOWWINDOW)
            If Timer2.Interval = 0 Then
                Timer1.Enabled = True
                Timer2.Interval = 1
            Else
                Timer1.Enabled = False
                Timer2.Interval = 0
            End If
            .Message = 0
         End If
      End With
   Loop Until wMsg.Message = WM_NCLBUTTONDOWN
End Sub
 
 
 
'Hotkey entfernen
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
   'Hotkey Deregistrieren
   Debug.Print UnregisterHotKey(Me.hwnd, hAtom)
 
   'Atom-ID zerstören
   Call GlobalDeleteAtom(hAtom)
End Sub
 
Private Sub Timer1_Timer()
SendMausklick MOUSE_LEFT
End Sub