Dim WithEvents favMsghook As msgHook
Private Const MF_BITMAP = &H4& 'Menu item is bitmap. lpNewItem = handle to bitmap.
Private Const MF_CHECKED = &H8& 'Check flag.
Private Const MF_DISABLED = &H2& 'Disable flag.
Private Const MF_ENABLED = &H0& 'Enable flag.
Private Const MF_GRAYED = &H1& 'Greyed flag.
Private Const MF_MENUBARBREAK = &H20& 'Seperator - verticle line if popup.
Private Const MF_MENUBREAK = &H40& 'Seperator - no columns.
Private Const MF_OWNERDRAW = &H100& 'Owner drawn.
Private Const MF_POPUP = &H10& 'Popup menu (Sub-menu).
Private Const MF_SEPARATOR = &H800& 'Seperator - dropdown only.
Private Const MF_STRING = &H0& 'Item is a string.
Private Const MF_UNCHECKED = &H0& 'Un-check flag.
Private Const MF_BYCOMMAND = &H0 ' der Wert stellt die Menü-ID dar
Private Const MF_BYPOSITION = &H400 ' der Wert stellt die nullbasierte relative
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetMenuItemCount Lib "user32.dll" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function RemoveMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal uPosition As Long, ByVal uFlags As Long) As Long
Private Declare Function InsertMenu& Lib "user32" Alias "InsertMenuA" (ByVal hMenu&, ByVal nPosition&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpNewItem$)
dim FavoritenMenuHandle as long
public function AddFavs()
dim x as Form
dim hMnu as long
dim hFavMnu as long
dim lngRC as long
set x = FormDieDasMenüBeinhaltenSoll
hMnu = GetMenu(x.hWnd)
hFavMnu = CreatePopupMenu()
FavoritenMenuHandle = hFavMnu
'Menüpunkte auf erster Ebene erstellen
lngRC = AppendMenu(hFavMnu, MF_STRING, lStart - 2, "Favoriten verwalten")
lngRC = AppendMenu(hFavMnu, MF_STRING, lStart - 1, "Favoriten hinzufügen")
lngRC = AppendMenu(hFavMnu, MF_SEPARATOR, 0, "Favoriten hinzufügen")
' An dieser Stelle lade ich aus einer Collection alle Favoriten die benötigt
' werden und füge sie auf die gleiche Art und weise an
' Man beachte nur, das die ID (-2, -1, 0) weitergeführt wird - daran hängt sich der
' MsgHook dann auf!
'Menüpunkt erstellen
lngRC = _
InsertMenu(hMnu, GetPositionOfItemByName(insertBeforeThisItem), _
MF_BYPOSITION Or MF_POPUP, hFavMnu, "Favoriten")
' Die Funktion GetPoitionOfItemByName tut nichts anderes als die Position
' eines MenüItems zu suche vor das es gesetzt werden soll - liefert long zurück
If bIsSet = False Then
' bIsSet ist ein bool um zu prüfen ob der Hook schonmal gesetzt wurde
' Wenn man den Hook öfter setzt dann fliegt einem der Spass um die Ohren!
Set favMsghook = New msgHook
favMsghook.Hook _
x.hWnd, WM_COMMAND, WM_CONST.WM_MENUSELECT
bIsSet = True
End If
end function
Private Sub favMsghook_After(uMsg As Long, wParam As Long, lParam As Long)
'Hier wird der Hook dann ausgewertet
If uMsg = WM_MENUSELECT AND lParam <> FavoritenMenuHandle Then Exit Sub
...
...
...
end sub
