Menu crée dynamiquement (sans passer par l'assistant de vb)

Télécharger le projet
Commenter

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 / Exemple : 


'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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_DARKSIDIOUS)