Option Explicit
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblLabel.BackColor = vbButtonFace
lblLabel.ForeColor = vbWindowText
End Sub
Private Sub lblLabel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblLabel.BackColor = vbHighlight
lblLabel.ForeColor = vbHighlightText
End Sub
Private Sub lblLabel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim oMenu As mcPopupMenu: Set oMenu = New mcPopupMenu
Dim oSubmenu1 As mcPopupMenu: Set oSubmenu1 = New mcPopupMenu
Dim oSubmenu2 As mcPopupMenu: Set oSubmenu2 = New mcPopupMenu
Dim oSubmenu3 As mcPopupMenu: Set oSubmenu3 = New mcPopupMenu
Dim x1 As Single, y1 As Single, Ret As Long
' Labels don't have a handle, set x,y manually
x1 = (Me.Left + 45 + lblLabel.Left) / 15 ' 15 twips per pixel
y1 = (Me.Top + 525 + lblLabel.Height) / 15
' Add a few of the main menu items
oMenu.Add 1, "Item 1"
oMenu.Add 2, "Item 2", True, , , imglstImages.ListImages(1).Picture
oMenu.Add 3, "Item 3", , , mceGrayed
oMenu.Add 4, "-" ' Seperator
' Build our submenus when needed
oSubmenu1.Caption = "Submenu 1"
oSubmenu1.Add 20, "Submenu 1 Item 1", , , mceGrayed, imglstImages.ListImages(2).Picture
oSubmenu1.Add 21, "Submenu 1 Item 2", , , , imglstImages.ListImages(3).Picture
oSubmenu1.Add 22, "Submenu 1 Item 3", , , , imglstImages.ListImages(4).Picture
' Submenu of the first submenu
oSubmenu2.Caption = "Submenu 2"
oSubmenu2.Add 30, "Submenu 2 Item 1"
oSubmenu2.Add 31, "Submenu 2 Item 2"
oSubmenu2.Add 32, "Submenu 2 Item 3"
' Add second submenu to first
oSubmenu1.Add 33, oSubmenu2
' Add first submenu to main.
oMenu.Add 5, oSubmenu1
oMenu.Add 6, "-" ' Another seperator
' Build third submenu
oSubmenu3.Caption = "Submenu 3"
oSubmenu3.Add 40, "Submenu 2 Item 1", , , , imglstImages.ListImages(2).Picture
oSubmenu3.Add 41, "Submenu 3 Item 2", , , , imglstImages.ListImages(3).Picture
oSubmenu3.Add 42, "Submenu 3 Item 3", , , , imglstImages.ListImages(4).Picture
oMenu.Add 7, oSubmenu3
oMenu.Add 8, "-" ' Yet another
' The remaining items in the main menu
oMenu.Add 9, "Item 4", , True
oMenu.Add 10, "Item 5", , , , imglstImages.ListImages(4).Picture
oMenu.Add 11, "Item 6", , True, mceGrayed
' Show popup
Ret = oMenu.Show(Me.Hwnd, x1, y1)
' Release objects
Set oSubmenu1 = Nothing: Set oSubmenu2 = Nothing: Set oSubmenu3 = Nothing: Set oMenu = Nothing
MsgBox "You chose menu ID " & Ret
Select Case Ret
' Lights, camera, action!
End Select
End Sub
Comments