API TrackPopupMenu + Menu racine (GetMenu(myForm.hwnd))

Bonsoir

Je cherche a afficher le menu racine
(GetMenu(myForm.hwnd)) en un endroit quelconque de la feuille.

Dans la version definitive, il s'agit bien sur de le faire apparaitre dans le System Tray

Dans les deux solutions les plus simples (simplistes) que j'ai ecrites:

-soit (5) l'affichage obtenu est tres particulier: barre verticale sans Caption)

-Soit (4) j'ai des 'fantomes' et eventuellemen un blocage.

J'ai une solution 3 qui fonctionne, mais s'il s'agit uniquement d'un point de detail pour faire fonctionner 4 ou 5 ...



Attribute VB_Name = "Module_HyperMenus"
Option Explicit
Option Compare Text
'############################################################################################
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) _
As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Declare Function GetMenu Lib "user32" _
(ByVal hwnd As Long) _
As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) _
As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPos 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 GetMenuItemID Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPos 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 CreatePopupMenu Lib "user32" _
() As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Declare Function TrackPopupMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal wFlags As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nReserved As Long, _
ByVal hwnd As Long, _
ByVal lprc As Any) _
As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As
Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
'Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal
hwnd As Long, ByVal lptpm As Any) As Long
'Private Const TPM_RECURSE As Long = &H1&
'############################################################################################
Private Const MF_BYPOSITION = &H400
Private Const MF_STRING = &H0&
Private Const MF_POPUP = &H10&
Private Const WM_NULL = &H0
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Const TPM_NONOTIFY = &H80&
Private Const TPM_RETURNCMD = &H100&
'############################################################################################
Public Sub Build_HyperMenu5(frmfrm As Form)
Dim MP As POINTAPI
Dim tMenuPOPx As Long 'Should always be returned as '1' because *not* TPM_RETURNCMD
Dim hMenu0 As Long 'handle to Menu 0
Dim myForm As Form
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set myForm = frmfrm
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GetCursorPos MP
hMenu0 = GetMenu(myForm.hwnd)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'SetForegroundWindow myForm.hwnd
tMenuPOPx = TrackPopupMenu(hMenu0, TPM_NONOTIFY, MP.x, MP.y, 0&, myForm.hwnd, 0&)
'PostMessage myForm.hwnd, WM_NULL, 0, 0
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub
'############################################################################################

Public Sub Build_HyperMenu4(frmfrm As Form)
Dim MP As POINTAPI
Static hMenuPOP As Long 'handle to POPUP menu
Dim tMenuPOPx As Long 'Should always be returned as '1' because *not* TPM_RETURNCMD
Dim hMenu0 As Long 'handle to Menu 0
Dim myForm As Form
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set myForm = frmfrm
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GetCursorPos MP
hMenu0 = GetMenu(myForm.hwnd)
If (hMenuPOP = 0) Then
hMenuPOP = CreatePopupMenu()
AppendMenu hMenuPOP, MF_POPUP, hMenu0, vbNullChar
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetForegroundWindow myForm.hwnd
tMenuPOPx = TrackPopupMenu(hMenuPOP, TPM_NONOTIFY, MP.x, MP.y, 0&, myForm.hwnd, 0&)
PostMessage myForm.hwnd, WM_NULL, 0, 0
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'DestroyMenu hMenuPOP
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub
'############################################################################################