Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: erbuson en Marzo 27, 2010, 01:30:10 pm
-
Por si a alguien de este foro le sirve de ayuda, aqui os dejo el enlace a un post que acabo de dejar en otro foro
http://www.foro.vb-mundo.com/f24/aporte-crear-popupmenu-api-facilisimo-17310/
-
Excelente aporte, lo acabo de probar y esta bueno. Muchas gracias.
-
Hermano será que puedes colocar el code ó subirlo a otra web...
-
Código de erbuson
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)
Public Function VerPopupMenu(ByVal hWnd As Long, ByVal MiMenu As String, Optional Numero As Boolean = False) As String
' Crea/Visualiza/Destruye un menu PopUp simple
' MiMenu es una cadena de elementos separados por ;
' Si el Nombre del elemento es guion (-) lo considera un separador
' Si Numero = True devuelve el número del elemento seleccionado en lugar del nombre del mismo
Dim xyMouse As POINTAPI
Dim mmPopup As Long, Valor As Long
Dim TMenu() As String, Elemento As Integer
TMenu = Split(MiMenu, ";")
Valor = 24575 ' De momento no se porque (se le va sumando 1 por cada elemento)
mmPopup = CreatePopupMenu()
For Elemento = 0 To UBound(TMenu)
Valor = Valor + 1
If TMenu(Elemento) = "-" Then
Call AppendMenu(mmPopup, &H0& Or &H800&, Valor, ByVal vbNullString) ' Separador
Else
Call AppendMenu(mmPopup, &H0&, Valor, ByVal TMenu(Elemento)) ' Elemento
End If
Next
GetCursorPos xyMouse
' Llama a la funcion API para visualizar el menu y toma el valor devuelto
Valor = TrackPopupMenu(mmPopup, &H100&, xyMouse.X, xyMouse.Y, 0&, hWnd, 0&)
If Valor > 24575 Then
Valor = Valor - 24576 ' Resta 24576 que es el valor extra del primer elemento
If Numero Then VerPopupMenu = Trim$(Str(Valor)) Else VerPopupMenu = TMenu(Valor)
End If
Call DestroyMenu(mmPopup)
End Function
Y este el codigo que invoca
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Si se pulsa Boton Derecho visualiza el PopupMenu
If Button = vbRightButton Then
Dim Opcion As String
Opcion = VerPopupMenu(Me.hWnd, "Uno;Dos;-;Tres", True)
If Opcion <> "" Then MsgBox Opcion
End If
End Sub
-
Gracias hermano YvanB... :D
-
Por si a alguien de este foro le sirve de ayuda, aqui os dejo el enlace a un post que acabo de dejar en otro foro
http://www.foro.vb-mundo.com/f24/aporte-crear-popupmenu-api-facilisimo-17310/
Muy bueno, me cae a pelo.
Saludos.
-
Tendrias que usar TrackPopupMenuEx y deshacerte de esos valores raros.
-
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
-
Muy buena la implementacion de submenu y de los check.
Saludos.