Dynamic Menu for VB6 application

[fafalone]

I'm still not following exactly what you're trying to do that clsMenuImage can't. You don't need VB menus at all. And the images and text can be loaded from files you could copy from your db to a temp folder.

Here's an example from my current project. Both the menu and submenu are created dynamically, using clsMenuImage to put the images on. If they were in your database, you would extract to a temp file and use .AddImageFromFile instead.

Public Function LVRCMenuPopup() As Long
'Displays the right click menu for ListView2
'Only way to get images on a popup menu not visible on the main bar
Dim hMenu As Long, hSubMenu As Long
Dim MII As MENUITEMINFO, mii2 As MENUITEMINFO
Dim PT As POINTAPI
Dim idCmd As Long
Dim rnf As RNFile
Dim cc As Long
Dim i As Long
Dim bDisable As Boolean
Dim lCnt As Long
Dim lMax As Long


Const sON As String = "Open File"
Const sNN As String = "Open Folder"
Const sTD As String = "Copy"
Const sDL As String = "Remove from list"
Const sST As String = "View"
Const sHT As String = "Hide Thumbnails"
Const sSR As String = "Save search results..."

Const sVX As String = "Extra Large Icons"
Const sVL As String = "Large Icons"
Const sVS As String = "Small Icons"
Const sVLS As String = "List"
Const sVD As String = "Details"
Const sVT As String = "Tiles"
Const sVTH As String = "Thumbnails"

On Error GoTo e0

Set cMenuImage = New clsMenuImage
Set cSubMenuImage = New clsMenuImage

lCnt = SendMessage(hLVS, LVM_GETSELECTEDCOUNT, 0, ByVal 0&)
lMax = SendMessage(hLVS, LVM_GETITEMCOUNT, 0, ByVal 0&)

'If lvSearch.ListItems.Count = 0 Then bDisable = True
If lCnt = 0 Then bDisable = True

hMenu = CreatePopupMenu()

With cMenuImage
    .Init Me.hwnd, 20, 20

    For i = 0 To 5
        .AddImageFromStream LoadResData("PNG_" & i, "CUSTOM")
    Next i
End With
With cSubMenuImage
    .Init Me.hwnd, 20, 20
    For i = 13 To 19
        .AddImageFromStream LoadResData("PNG_" & i, "CUSTOM")
    Next i
End With

'Construct the View submenu

hSubMenu = CreateMenu()
With mii2
    .cbSize = Len(mii2)
    
    
    .fMask = MIIM_STRING Or MIIM_ID Or MIIM_STATE
    .wID = idV_XL
    .dwTypeData = sVX
    .cch = Len(sVX)
    .fState = IIf(iCurViewMode = 0, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 0, True, mii2)

    .wID = idV_LG
    .dwTypeData = sVL
    .cch = Len(sVL)
    .fState = IIf(iCurViewMode = 1, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 1, True, mii2)

    .wID = idV_SM
    .dwTypeData = sVS
    .cch = Len(sVS)
    .fState = IIf(iCurViewMode = 2, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 2, True, mii2)

    .wID = idV_LS
    .dwTypeData = sVLS
    .cch = Len(sVLS)
    .fState = IIf(iCurViewMode = 3, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 3, True, mii2)

    .wID = idV_DT
    .dwTypeData = sVD
    .cch = Len(sVD)
    .fState = IIf(iCurViewMode = 4, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 4, True, mii2)

    .wID = idV_TI
    .dwTypeData = sVT
    .cch = Len(sVT)
    .fState = IIf(iCurViewMode = 5, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 5, True, mii2)

    .fMask = MIIM_ID Or MIIM_TYPE
    .fType = MFT_SEPARATOR
    .wID = 0
    Call InsertMenuItem(hSubMenu, 6, True, mii2)

    .fMask = MIIM_STRING Or MIIM_ID Or MIIM_STATE
    .wID = idV_TH
    .dwTypeData = sVTH
    .cch = Len(sVTH)
    .fState = IIf(iCurViewMode = 6, MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hSubMenu, 7, True, mii2)

End With

With MII
    .cbSize = Len(MII)
    
    'Open file
    .fMask = MIIM_ID Or MIIM_STRING Or MIIM_STATE
    .wID = idFS_OpenFile
    .dwTypeData = sON
    .cch = Len(sON)
    .fState = IIf(bDisable, MFS_DISABLED, MFS_ENABLED)
    .fState = .fState Or MFS_DEFAULT
    '.fState = IIf(bStates(0), MFS_ENABLED, MFS_DISABLED)
    '.fState = .fState Or IIf(LV2ColCheck(0), MFS_CHECKED, MFS_UNCHECKED)
    Call InsertMenuItem(hMenu, 0, True, MII)
    
    'Open folder
    .fMask = MIIM_ID Or MIIM_STRING Or MIIM_STATE
    .wID = idFS_OpenFolder
    .dwTypeData = sNN
    .cch = Len(sNN)
    .fState = IIf(bDisable, MFS_DISABLED, MFS_ENABLED)

    '.fState = IIf(bStates(1), MFS_ENABLED, MFS_DISABLED)
    '.fState = .fState Or IIf(LV2ColCheck(1), MFS_CHECKED, MFS_UNCHECKED)

    Call InsertMenuItem(hMenu, 1, True, MII)
    
    'Copy
    .fMask = MIIM_STRING Or MIIM_ID Or MIIM_STATE
    .wID = idFS_CopyFile
    .dwTypeData = sTD
    .cch = Len(sTD)
    .fState = IIf(bDisable, MFS_DISABLED, MFS_ENABLED)

    '.fState = IIf(bStates(2), MFS_ENABLED, MFS_DISABLED)
    '.fState = .fState Or IIf(LV2ColCheck(2), MFS_CHECKED, MFS_UNCHECKED)

    Call InsertMenuItem(hMenu, 2, True, MII)
    
     'Copy
    .fMask = MIIM_STRING Or MIIM_ID Or MIIM_STATE
    .wID = idFS_Remove
    .dwTypeData = sDL
    .cch = Len(sDL)
    .fState = IIf(bDisable, MFS_DISABLED, MFS_ENABLED)

    '.fState = IIf(bStates(2), MFS_ENABLED, MFS_DISABLED)
    '.fState = .fState Or IIf(LV2ColCheck(2), MFS_CHECKED, MFS_UNCHECKED)

    Call InsertMenuItem(hMenu, 3, True, MII)
   
    'Sep
    .fMask = MIIM_ID Or MIIM_TYPE
    .fType = MFT_SEPARATOR
    .wID = 0
    Call InsertMenuItem(hMenu, 4, True, MII)
    
    'view menu
    .fMask = MIIM_SUBMENU Or MIIM_TYPE
    .fType = MFT_STRING
    .wID = idFS_Thumb
    .dwTypeData = sST
    .cch = Len(sST)
    .hSubMenu = hSubMenu
    Call InsertMenuItem(hMenu, 5, True, MII)
    
    'Sep
    .fMask = MIIM_ID Or MIIM_TYPE
    .fType = MFT_SEPARATOR
    .wID = 0
    Call InsertMenuItem(hMenu, 6, True, MII)
    
    'save
    .fMask = MIIM_ID Or MIIM_STRING Or MIIM_STATE
    .wID = idFS_Save
    .dwTypeData = sSR
    .cch = Len(sSR)
    .fState = IIf(lMax = 0, MFS_DISABLED, MFS_ENABLED)

    '.fState = IIf(bStates(1), MFS_ENABLED, MFS_DISABLED)
    '.fState = .fState Or IIf(LV2ColCheck(1), MFS_CHECKED, MFS_UNCHECKED)

    Call InsertMenuItem(hMenu, 7, True, MII)
    
End With
Debug.Print "iid=" & GetMenuItemID(hMenu, 5)
With cMenuImage
        .PutImageToApiMenu 0, hMenu, 0
        .PutImageToApiMenu 1, hMenu, 1
        .PutImageToApiMenu 2, hMenu, 2
        .PutImageToApiMenu 3, hMenu, 5
        .PutImageToApiMenu 4, hMenu, 7
        .PutImageToApiMenu 5, hMenu, 3
        If Not .IsWindowVistaOrLater Then
            .RemoveMenuCheckApi hMenu
        End If
End With
With cSubMenuImage
        .PutImageToApiMenu 0, hSubMenu, 0
        .PutImageToApiMenu 1, hSubMenu, 1
        .PutImageToApiMenu 2, hSubMenu, 2
        .PutImageToApiMenu 3, hSubMenu, 3
        .PutImageToApiMenu 4, hSubMenu, 4
        .PutImageToApiMenu 5, hSubMenu, 5
        .PutImageToApiMenu 6, hSubMenu, 7
        If Not .IsWindowVistaOrLater Then
            .RemoveMenuCheckApi hMenu
        End If
End With

Call GetCursorPos(PT)

idCmd = TrackPopupMenu(hMenu, TPM_LEFTBUTTON Or TPM_RIGHTBUTTON Or TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_HORIZONTAL Or TPM_RETURNCMD, PT.X, PT.Y, 0, Me.hwnd, 0)

If idCmd Then
    Select Case idCmd
        
        Case idFS_OpenFile
           
'[process code for all commands, not relevent]
                
    End Select
End If

Call DestroyMenu(hMenu)
Call DestroyMenu(hSubMenu)
Set cMenuImage = Nothing
Set cSubMenuImage = Nothing

LVRCMenuPopup = idCmd

On Error GoTo 0
Exit Function

e0:
DebugAppend "frmSearch.LVRCMenuPopup.Error->" & Err.Description & " (" & Err.Number & ")"

End Function

This is the result: