Option Explicit
Option Compare Text
 
DefInt I-K
DefLng H, L, N
DefSng S
DefCur C
DefDbl D
DefStr T
DefVar V
DefByte B
DefBool F
DefObj O
DefDate Z
 
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd _
  As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long) As Long
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
 
Const WM_APPCOMMAND As Integer = 793 'Monitor Multimedia events
Const GWL_WNDPROC = (-4)
 
'Multimedia key constants
Const MMkey_Play As Long = 917504
Const MMkey_Stop As Long = 851968
Const MMkey_Prev_Item As Long = 65536
Const MMkey_Next_Item As Long = 131072
Const MMkey_Prev_Track As Long = 786432
Const MMkey_Next_Track As Long = 720896
 
'So, das muss noch in die Form-Events der Startform:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Private Sub Form_Load()
'  Hook hwnd, True
'End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'  Hook hwnd, False
'End Sub
 
Public OldProc As Long 'Speichert das originale Prozedure-Handle (zum 
' Weiterreichen und zum Zurücksetzen)
 
Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As _
  Long, ByVal lParam As Long) As Long
  Dim MenuHandle As Long, MenuCloseID As Long
  'hier kommen nun sämtliche Fenstermeldungen an, welche für meine Form 
  ' bestimmt sind
  'da können wir uns die passenden raussuchen
  If wMsg = WM_APPCOMMAND Then
    If OnMMKeypress(lParam) = True Then
      'Fenstermeldungen, welche wir hier schon bearbeitet haben, werden nicht 
      ' weitergereicht
      WndProc = 0
      Exit Function
    End If
  End If
  'Fenstermeldungen, die wir nicht benutzen, werden einfach an die originale 
  ' Prozedur weitergeleitet
  WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
End Function
 
Public Sub Hook(ByVal hwnd As Long, Optional state As Boolean = True)
  If state = True Then
    'originales Prozedur-Handle speichern, und unser eigenes einsetzen
    OldProc = GetWindowLong(hwnd, GWL_WNDPROC)
    SetWindowLong hwnd, GWL_WNDPROC, AddressOf WndProc
  Else
    'originales Prozedur-Handle wieder einsetzen
    SetWindowLong hwnd, GWL_WNDPROC, OldProc
  End If
End Sub
 
Public Function OnMMKeypress(mmkeycode As Long) As Boolean
  OnMMKeypress = True
  Select Case mmkeycode
    Case MMkey_Play:        Debug.Print "Play"
    Case MMkey_Stop:        Debug.Print "Stop"
    Case MMkey_Prev_Item:   Debug.Print "PrevItem"
    Case MMkey_Next_Item:   Debug.Print "NextItem"
    Case MMkey_Prev_Track:  Debug.Print "PrevTrack"
    Case MMkey_Next_Track:  Debug.Print "NextTrack"
    Case Else
      Debug.Print "Play"
      OnMMKeypress = False
  End Select
End Function