Bueno, adjunto modificación efectuada sobre la idea anterior pero con mas posibilidades como puede verse en la línea de llamada al mismo
"Leer/-/#Editar;Copiar;'Pegar;Cortar/Grabar/Color;Verde;Rojo;#Azul/'Salir"
La barra / actúa como separador de Items
Un Item puede ser un Submenú hallándose separados el título del mismo y los elementos por punto y coma ;
Un Item puede mostrarse Chequeado si se precede del apostrofe ' o bloqueado si se precede de #
Por otra parte he descubierto el porque de los número raros y cuando el menu devuelve un numero el valor devuelto es 1, 2, 3, 4, 5, en función del menú principal y cuando se trata de un submenu devuelve 101, 102, 103 para el primer submenu, 201, 202, 203 para el segundo etc,...
Como con estas opciones ya me resultan mucho mas que suficientes , por el momento no me complico mas la existencias.
Saludos
'##### Insertar el siguiente código en un Form en blanco y ejecutar #####
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function CreatePopupMenu Lib "User32" () As Long
Private Declare Function DestroyMenu Lib "User32" (ByVal hMenu&) As Long
Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal hMenu&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpNewItem$) As Long
Private Declare Function TrackPopupMenu Lib "User32" (ByVal hMenu&, ByVal wFlags&, ByVal X&, ByVal Y&, ByVal nReserved&, ByVal Hwnd&, ByVal lpRect&) As Long
Private Declare Sub GetCursorPos Lib "User32" (lpPoint As POINTAPI)
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
Me.Caption = ElegirMenu(Me.Hwnd, "Leer/-/#Editar;Copiar;'Pegar;Cortar/Grabar/Color;Verde;Rojo;#Azul/'Salir")
End If
End Sub
Public Function ElegirMenu(Hwnd As Long, MiMenu As String, Optional Numero As Boolean = False) As String
Dim HwMenus(25) As Long, HwMenu As Integer
Dim Menus() As String, SubMenus() As String, Elemento As Integer, Linea As Integer
Dim Valor As Long
Dim Titulos(1000) As String
HwMenus(0) = CreatePopupMenu()
Menus() = Split(MiMenu, "/")
For Elemento = 0 To UBound(Menus)
Valor = Valor + 1
If InStr(Menus(Elemento), ";") Then
' Es un SubMenu
SubMenus() = Split(Menus(Elemento), ";")
HwMenu = HwMenu + 1
HwMenus(HwMenu) = CreatePopupMenu()
For Linea = 1 To UBound(SubMenus)
Call CrearItemMenu(HwMenus(HwMenu), SubMenus(Linea), CLng(100 * HwMenu + Linea))
Titulos(100 * HwMenu + Linea) = SubMenus(0) & SubMenus(Linea)
Next
If Left$(SubMenus(0), 1) = "#" Then
Call AppendMenu(HwMenus(0), &H0& Or &H10& Or &H1&, HwMenus(HwMenu), ByVal Mid$(SubMenus(0), 2))
Else
Call AppendMenu(HwMenus(0), &H0& Or &H10&, HwMenus(HwMenu), ByVal SubMenus(0))
End If
ElseIf Menus(Elemento) = "-" Then
Call CrearItemMenu(HwMenus(0), Menus(Elemento), 999)
Else
Call CrearItemMenu(HwMenus(0), Menus(Elemento), Valor)
Titulos(Valor) = Menus(Elemento)
End If
Next
Dim Donde As POINTAPI
GetCursorPos Donde
Valor = TrackPopupMenu(HwMenus(0), &H100&, Donde.X, Donde.Y, 0&, Hwnd, 0&)
If Numero Then
ElegirMenu = Str$(Valor)
Else
ElegirMenu = Titulos(Valor)
End If
For Linea = 0 To HwMenu
DestroyMenu HwMenus(Linea)
Next
End Function
Private Sub CrearItemMenu(HWndMenu As Long, Texto As String, Valor As Long)
' Crea en el Menu indicado el Item. Controlando diversas opciones del mismo.
If Texto = "-" Then
' Barra Separadora
Call AppendMenu(HWndMenu, &H0& Or &H800&, 999&, ByVal vbNullString)
Else
If Left$(Texto, 1) = "'" Then
' Elemento Chechked
Texto = Mid$(Texto, 2)
Call AppendMenu(HWndMenu, &H0& Or &H8&, Valor, ByVal Texto)
ElseIf Left$(Texto, 1) = "#" Then
' Elemento Locked
Texto = Mid$(Texto, 2)
Call AppendMenu(HWndMenu, &H0& Or &H1&, Valor, ByVal Texto)
Else
Call AppendMenu(HWndMenu, &H0&, Valor, ByVal Texto)
End If
End If
End Sub
' ###########
Después puede pasarse a un modulo.
Saludos
