Accueil > > > MENU CRÉE DYNAMIQUEMENT (SANS PASSER PAR L'ASSISTANT DE VB)
MENU CRÉE DYNAMIQUEMENT (SANS PASSER PAR L'ASSISTANT DE VB)
Information sur la source
Description
Cette source vous permet de créer des menus lors de l'éxécution et non lors de la création du projet avec l'assistant de VB.
Quel est l'intérêt demandez-vous ? Et bien imaginez un programme qui doit charger des menus de façon totalement dynamique car vous ne connaissez pas leurs contenus lors de la création (leur contenu peut par exemple être définis dans une dll ou un fichier), ou alors, imaginez un programme ayant besoin de 15 sous-menus qui chacun contient 15 sous-sous-menus dont certains ne doivent pas être affichés en permance ! Vous vous dites, c'est un peu tiré par les cheveux ! Et pourtant, cela m'est arrivé dans un projet de tri de flèches pour un prog de tir à l'arc ! De plus, cela permet d'économiser un tout petit peu de place au niveau de l'exe car les menus ne sont alors pas intégrés dans les ressources du prog, mais bel et bien crée lors de l'éxécution ! La fonction d'affichage des menus renvoie de plus l'ID du menu qui a été cliqué par l'utilisateur... pratique si vous voulez pouvoir faire réagir votre prog selon la sélection de l'utilisateur quand même ;)
Pour ce faire, j'utilise bien entendu les fonctions de l'API Windows concernant les menus.
Source
- '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
-
'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
Conclusion
Il s'agit d'une vieille source que j'avais développé et qui a été demandée par Progi1984. Je la poste donc pour lui répondre, ainsi que pour tout ceux à qui ca peut intéresser.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|