Soyez le premier à donner votre avis sur cette source.
Vue 14 073 fois - Téléchargée 2 036 fois
'déclaration des constantes API privées à l'objet Private Const MIIM_ID = &H2 Private Const MIIM_TYPE = &H10 Private Const MIIM_STATE = &H1 Private Const MIIM_SUBMENU = &H4 Private Const TPM_LEFTALIGN = &H0& Private Const TPM_RETURNCMD = &H100& Private Const TPM_RIGHTBUTTON = &H2& Private Const MFT_RADIOCHECK = &H200& Private Const MFT_CHECKED = &H8& Private Const MFT_STRING = &H0 Private Const MFS_ENABLED = &H0 'déclaration des types privés à l'objet Private Type MENUITEMINFO cbSize As Long fMask As Long fType As Long fState As Long wID As Long hSubMenu As Long hbmpChecked As Long hbmpUnchecked As Long dwItemData As Long dwTypeData As String cch As Long End Type Private Type POINTAPI x As Long y As Long End Type 'déclaration des fonctions API privées à l'objet Private Declare Function CreatePopupMenu Lib "user32" () As Long Private Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long Private 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 Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long Public Function AfficherMenu() As Long '====================================================== 'Permet de créer le menu, puis de l'afficher ' 'Renvoie l'ID du menu cliqué 'Renvoie -1 en cas d'erreur '====================================================== 'on active la routine de traitement d'erreur On Error GoTo erreur0 'déclaration des variables privées Dim pMenuInfo As MENUITEMINFO 'définit les info de l'item de menu ajouté Dim pPositionCurseur As POINTAPI 'stocke la position actuelle du curseur Dim lHandleMenu As Long 'stocke le handle du menu Dim lHandleSousMenu(1) As Long 'stocke les handles des sous-menus Dim lHandleSousSousMenu(1) As Long 'stocke les handles des sous-sous-menus 'on définit le handle du menu popup Let lHandleMenu = CreatePopupMenu Let lHandleSousMenu(0) = CreatePopupMenu Let lHandleSousMenu(1) = CreatePopupMenu Let lHandleSousSousMenu(0) = CreatePopupMenu Let lHandleSousSousMenu(1) = CreatePopupMenu 'on définit le nouveau sous-sous-menu : With pMenuInfo Let .cbSize = Len(pMenuInfo) Let .fType = MFT_STRING Let .fState = MFS_ENABLED Let .dwTypeData = "Sous-Sous-Menu1" Let .cch = Len(pMenuInfo.dwTypeData) Let .wID = 100 Let .fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE End With Call InsertMenuItem(lHandleSousMenu(0), 0, True, pMenuInfo) 'on définit le nouveau sous-sous-menu : With pMenuInfo Let .cbSize = Len(pMenuInfo) Let .fType = MFT_STRING Let .fState = MFS_ENABLED Let .dwTypeData = "Sous-Sous-Menu2" Let .cch = Len(pMenuInfo.dwTypeData) Let .wID = 101 Let .fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE End With Call InsertMenuItem(lHandleSousMenu(0), 1, True, pMenuInfo) 'on insère un nouveau menu dans le menu courant : With pMenuInfo Let .cbSize = Len(pMenuInfo) Let .fType = MFT_STRING Let .fState = MFS_ENABLED Let .dwTypeData = "Sous-Menu1" Let .cch = Len(pMenuInfo.dwTypeData) Let .wID = 0 Let .fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU Let .hSubMenu = lHandleSousMenu(0) End With Call InsertMenuItem(lHandleMenu, 0, True, pMenuInfo) 'on définit le nouveau sous-sous-menu : With pMenuInfo Let .cbSize = Len(pMenuInfo) Let .fType = MFT_STRING Let .fState = MFS_ENABLED Let .dwTypeData = "Sous-Sous-Menu1" Let .cch = Len(pMenuInfo.dwTypeData) Let .wID = 102 Let .fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE End With Call InsertMenuItem(lHandleSousMenu(1), 0, True, pMenuInfo) 'on définit le nouveau sous-sous-menu : With pMenuInfo Let .cbSize = Len(pMenuInfo) Let .fType = MFT_STRING Let .fState = MFS_ENABLED Let .dwTypeData = "Sous-Sous-Menu2" Let .cch = Len(pMenuInfo.dwTypeData) Let .wID = 103 Let .fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE End With Call InsertMenuItem(lHandleSousMenu(1), 1, True, pMenuInfo) 'on insère un nouveau menu dans le menu courant : With pMenuInfo Let .cbSize = Len(pMenuInfo) Let .fType = MFT_STRING Let .fState = MFS_ENABLED Let .dwTypeData = "Sous-Menu2" Let .cch = Len(pMenuInfo.dwTypeData) Let .wID = 1 Let .fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU Let .hSubMenu = lHandleSousMenu(1) End With Call InsertMenuItem(lHandleMenu, 1, True, pMenuInfo) 'on affiche le menu crée Call GetCursorPos(pPositionCurseur) Let AfficherMenu = TrackPopupMenuEx(lHandleMenu, TPM_LEFTALIGN Or TPM_RIGHTBUTTON Or TPM_RETURNCMD, pPositionCurseur.x, pPositionCurseur.y, Me.hwnd, ByVal 0&) Call DestroyMenu(lHandleMenu) Call DestroyMenu(lHandleSousMenu(0)) Call DestroyMenu(lHandleSousMenu(1)) Call DestroyMenu(lHandleSousSousMenu(0)) Call DestroyMenu(lHandleSousSousMenu(1)) 'la fonction a réussie Exit Function 'routine de traitement d'erreur erreur0: 'Problème : On n'a pas pu afficher le menu ou on ne connaît pas l'ID du menu sélectionné 'Solution : On renvoie une valeur d'erreur : -1 Let AfficherMenu = -1 End Function Private Sub Form_Click() Select Case AfficherMenu Case 100 MsgBox "Vous avez cliquez sur le sous-sous menu 1 du sous-menu 1" Case 101 MsgBox "Vous avez cliquez sur le sous-sous menu 2 du sous-menu 1" Case 102 MsgBox "Vous avez cliquez sur le sous-sous menu 1 du sous-menu 2" Case 103 MsgBox "Vous avez cliquez sur le sous-sous menu 2 du sous-menu 2" End Select End Sub
Merci.
DarK Sidious
Thanks pour le code,
Je l'ai pas encore essayer, je crée mon code en notepad et je corrigerai le reste un peu plus tard, je le teste de temps à autres chez nous, mais la j'intègre la section menu.
En passant est-ce qu'il y a un moyen d'insérer une barre entre les menus pour diférencier des sections
C'est à dire pour NotePad par exemple, il y a une barre entre dans "Édition" entre "Annuler" et "Couper"
Je me demandais aussi, quand on click sur le menu, quelle est l'options généré pour que j'y génère du code en retour...
Ce que je veux faire, c'est un menu généré directement à partir d'une base de donnée access. La base de donnée contenant à la fois le titre et la commande a executer.
Merci
Merci, @+
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.