Creating SubMenus at RunTime in VB6

StewartJ used Ask the Experts™
In VB6, I need to dynamically create submenus which themselves have submenus so as to achieve something like :

    Recent Doc 1
    Recent Doc 2

etc depending on how many docs (or whatever) found

I can create the first level (Recent Doc x) easily using the InsertMenuItem API and sub-class to detect when it's clicked but I can't get a handle to it from GetSubMenu so as to be able to insert the next level (Open / Print etc).  Thus,

    InsertMenuItem ByVal l_hFileMenu, ByVal 1, ByVal True, l_uMenuInfo
    l_hSubMenu = GetSubMenu(ByVal l_hFileMenu, ByVal 0)

l_hSubMenu always is returned as zero regardless of the value of the position parameter.

Any advice would be much appreciated.
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®


Thanks for the quick reply, but this only works at the first level.  I need to add further submenus to those that I create.  So, I will create an item 'File1' but, when the user clicks it, I want a further submenu to appear, for example, giving her the options of 'Edit', 'Print' or 'Delete'.
Hi StewartJ: "How do I add subitems to a at runtime generated popup menu"

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!


Thanks, this is what I am doing but I can get it to work only for one level.  I cannot find any way to get the handle of the item that I've added so that I can give IT further sub-menus.
I suppose upgrading to .NET is out of the question?
Its quite easy there as illustrated in my answer in "Dynamically implementing a context menu on a grpBox's button click event in VB.NET"



On this occassion, regrettably not !
You can use popup menu to simulate second level:

Create a command button and, using Menu Editor, create this menu tree:

Caption          Name                     Visible            Index
Hidden           mnuHidden             False             no index
...Open          mnuOpen               True              no index
...Print           mnuPrint                True              no index
...Delete         mnuDelete             True              no index
File                mnuFile                 True              no index
...-                 mnuSeparator        True             no index
...Document    mnuDocument        False                 0

Paste this code:
Option Explicit

Dim DocumentIndex As Integer

Private Sub Command1_Click()
    Dim x As Integer
    For x = 1 To 10
        Load mnuDocument(x)
        mnuDocument(x).Caption = "Document " & x
        mnuDocument(x).Visible = True
    Next x
End Sub

Private Sub Form_Load()
    Command1.Caption = "Add documents"
End Sub

Private Sub mnuDocument_Click(Index As Integer)
    DocumentIndex = Index
    PopupMenu mnuHidden
End Sub

Private Sub mnuOpen_Click()
    MsgBox "Openning document " & DocumentIndex & " ..."
End Sub

Private Sub mnuPrint_Click()
    MsgBox "Printing document " & DocumentIndex & " ..."
End Sub

Private Sub mnuDelete_Click()
    MsgBox "Deleting document " & DocumentIndex & " ..."
End Sub


That looks promising, thanks.  I have an urgent task to complete at the moment but will try it later and report results.
>>but I can't get a handle to it from GetSubMenu
When you insert a new item into a menu (handle), it's just a menu item (with no sub-menu!). So, that's why you cannot get the sub-menu for it.. because it does not exist. You'll have to create the sub-menu yourself, insert the items to it, and change the menu (that you're creating a sub-menu for) so that it knows the newly created sub-menu belongs to it. I'm guessing that sounds confusing.. can't really explain it any better at the moment.. insomnia.. @-)

Try the below.. create a top-level menu ("File", for example) and that's it. You'll have to change the optional intPos parameter to the position of that menu if it's not the first one (0.. by default.. as the first).

Option Explicit

    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 Declare Function CreateMenu Lib "user32" () 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 GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpmii As MENUITEMINFO) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long

Private Const MIIM_TYPE = &H10
Private Const MIIM_SUBMENU = &H4
Private Const MFT_STRING = &H0
Private Sub Form_Load()
    Dim hMenu As Long, hSubMenu As Long
    hMenu = GetMenu(Me.hWnd)
    If hMenu <> 0 Then
        '1st set of menus...
        hSubMenu = MenuInsert(hMenu, "Recent Doc 1")
            Call MenuInsert(hSubMenu, "Open", 0)
            Call MenuInsert(hSubMenu, "Print", 0)
            hSubMenu = MenuInsert(hSubMenu, "Delete", 0)
                Call MenuInsert(hSubMenu, "Delete 1...", 2)
                Call MenuInsert(hSubMenu, "Delete 2...", 2)
        '2nd set of menus...
        hSubMenu = MenuInsert(hMenu, "Recent Doc 2")
            Call MenuInsert(hSubMenu, "Open", 1)
            Call MenuInsert(hSubMenu, "Print", 1)
            hSubMenu = MenuInsert(hSubMenu, "Delete", 1)
                Call MenuInsert(hSubMenu, "Delete 3...", 2)
                Call MenuInsert(hSubMenu, "Delete 4...", 2)
    End If
End Sub
Private Function MenuInsert(ByVal hMenu As Long, ByVal strCaption As String, Optional ByVal intPos As Integer = 0) As Long
    'well.. i didn't want to complicate things.. so you'll need to keep track of the position you're adding
    'sub-menus to (intPos).. might be confusing at first.. but it seems to work
    Dim typMII As MENUITEMINFO, hSubMenu As Long, intMenuCnt As Integer
    'this is to ensure the menu you're attempting to add items to has a sub-menu first..
    'if it doesn't, we create a new menu.. if it does, we reuse the existing one
    typMII.cbSize = Len(typMII)
    typMII.fMask = MIIM_SUBMENU
    Call GetMenuItemInfo(hMenu, intPos, True, typMII)
    If typMII.hSubMenu = 0 Then
        hSubMenu = CreateMenu
        typMII.hSubMenu = hSubMenu
        Call SetMenuItemInfo(hMenu, intPos, True, typMII)
        hSubMenu = typMII.hSubMenu
    End If
    'just initialize the structure to add our menu string
    intMenuCnt = GetMenuItemCount(hSubMenu)
    typMII.fMask = MIIM_TYPE
    typMII.fType = MFT_STRING
    typMII.dwTypeData = strCaption
    typMII.cch = Len(typMII.dwTypeData)
    'we then insert it..
    Call InsertMenuItem(hSubMenu, intMenuCnt, True, typMII)
    'and return the handle to the newly created menu.. in case we wish to add sub-items
    'to it ;-)
    MenuInsert = GetSubMenu(hMenu, intPos)
End Function


That looks good too, but Morpheus has caught up with me as well!  I'll get back to it tomorrow.  Thanks all for your help.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial