Crear Menu con SubMenú usando APIs
Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Access y VBA
Descripción del foro: Foro de programacion en Access (Con código y sin código)
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=87045
Fecha de impresión: 26/Marzo/2026 a las 15:28
Tema: Crear Menu con SubMenú usando APIs
Publicado por: Plinio Montano
Asunto: Crear Menu con SubMenú usando APIs
Fecha de publicación: 14/Marzo/2025 a las 05:15
|
Saludos estimados colegas, reciban mis deseos de salud y bienestar para todos
Hasta ahora no habia tenido la necesidad de crear sub menús, solo habia creado menus emergentes.
Estoy tratando de crear un menú emergente que me permita en una de sus opciones acceder a otro submenú
Ej.
- Item 1 - Item 1.1 ...
Para probar he crado un formulario con un botón que al hacer click llame al menú y que al hacer click en el Item 1 llame al submenú con los Item 1.1, Item 1.2, Item 1.3. Pero no me funciona, pido a ustedes le den una miradita y me digan si es posible hacerlo y en que estoy fallando.
Aquí le muestro el código que he programado:
Option Compare Database Option Explicit
Dim Menu, SubMenu
Private Function CreaMenu() SubMenu = CreatePopupMenu() AppendMenu SubMenu, MF_STRING, 1, "Item 1.1" AppendMenu SubMenu, MF_STRING, 2, "Item 1.2" AppendMenu SubMenu, MF_STRING, 3, "Item 1.3"
Menu = CreatePopupMenu() AppendMenu Menu, MF_POPUP, 1, "Item 1" End Function
Private Sub Form_Load() CreaMenu End Sub
Private Sub Comando0_Click() Dim PTr As POINTAPI Dim lngOpcion GetCursorPos PTr lngOpcion = TrackPopupMenuEx(lngMenu1, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, PTr.X, PTr.Y, Me.hwnd, ByVal 0&) End Sub
-------------
pmv
|
Respuestas:
Publicado por: Plinio Montano
Fecha de publicación: 14/Marzo/2025 a las 15:28
|
Por favor disculpen le vuelvo poner el código, solo me sale el Menú cuando le doy click en la opción no me muestra el SubMenú
Dim Menu, SubMenu
Private Function CreaMenu() Dim Ptr1 SubMenu = CreatePopupMenu() AppendMenu SubMenu, MF_STRING, 1, "Item 1.1" AppendMenu SubMenu, MF_STRING, 2, "Item 1.2" AppendMenu SubMenu, MF_STRING, 3, "Item 1.3" Ptr1 = VarPtr(SubMenu) Menu = CreatePopupMenu() AppendMenu Menu, MF_POPUP, Ptr1, "Item 1" End Function
Private Sub Form_Load() CreaMenu End Sub
Private Sub Comando0_Click() Dim PTr As POINTAPI Dim lngOpcion GetCursorPos PTr lngOpcion = TrackPopupMenuEx(Menu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, PTr.X, PTr.Y, Me.hwnd, ByVal 0&) End Sub
-------------
pmv
|
Publicado por: Mihura
Fecha de publicación: 15/Marzo/2025 a las 09:07
Ahí falta rutinas / código pOr poner ¿NO?
-------------
Jesús Mansilla Castells.
Saludos desde Móstoles.
http://www.accessaplicaciones.com" rel="nofollow - Access Aplicaciones
http://www.tecsys.es" rel="nofollow - Tecsys.es
|
Publicado por: Plinio Montano
Fecha de publicación: 17/Marzo/2025 a las 02:25
|
Saludos.
Estimado Mihura le pido me disculpe por la demora en responderte, no habia podido conectarme, vivo en Cuba y tuvimos más de 48 horas sin electricidad.Tienes razón, me faltó poner un Select Case para dar opciones en la toma de desiciones según el valor devuelto en lngOpcion, en realidad no puese esa parte del código en la pregunta ya que pensé que no era necesaria, al tratar de refereirme al problema de forma generica, ya que problema lo tengo en la apertura del menú en sus SubMenú.
No logro el enlace correcto entre las opciones del Menú con sus correspondientes SubMenus
En el Evento Load del formulario cargo las variables de menú: (Menu y SubMenu), llamando la función CreaMenu() y luego al hacer click en el Botón de Comando en su evento Click, que tambien podría haber sido en el evento al Bajar el Mouse, llamo a la ejecución del Menu.
Private Sub Comando0_Click() Dim PTr As POINTAPI Dim lngOpcion GetCursorPos PTr lngOpcion = TrackPopupMenuEx(Menu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, PTr.X, PTr.Y, Me.hwnd, ByVal 0&)
Select Case lngOpcion Case 1: ........ Case 2 ........ Case 3 ........ End select End Sub
El problema esta en que solo me muestra:
Item 1
y cuando lo selecciono no me muestra el SubMenu.
Lo que necesito es que cuando de Click en Item 1 me muestré:
Item 1.1
y no logro que lo haga.
Mi intención es que al dar click en la opción del Menú me habra las opciones del SubMenú y es precisamente lo que no logoro hacer.
Item 1 Item 1.1 Item 1.2 Item 1.3
Traté incluso llamar al SubMenu pero cuando lo hago me oculta el Menu
Siempre había trabajo con Menus simple, este mi primer reto creando una Secuencia de Menús y SubMenús
-------------
pmv
|
Publicado por: Mihura
Fecha de publicación: 17/Marzo/2025 a las 11:16
|
Hola Plinio,
Siento mucho leer eso del corte de electricidad ... más de dos días ... ¡Dios mío!
Veo que usas APIs para el tema de los menús ... ese es un tema que desconozco, a ver si nos lee alguien que si los use.
Un saludo.
-------------
Jesús Mansilla Castells.
Saludos desde Móstoles.
http://www.accessaplicaciones.com" rel="nofollow - Access Aplicaciones
http://www.tecsys.es" rel="nofollow - Tecsys.es
|
Publicado por: Plinio Montano
Fecha de publicación: 17/Marzo/2025 a las 14:06
|
Buenos días colegas. Saludos especiales a Mihura que ha estado pendiente de mi pregunta. Le comento que creo haber resuelto el problema, como dice Mihura estoy usando APis Win32, al parecer era que no habia declarado correctamente la constante MF_POPUP.
Aquí pongo a disposición de todos ambos módulos el de Declaraciones (Mod_Declaraciones) y el asociado al formulario (Frm_Prueba_Menu).
Cualquier criterio o recomendación siempre será bien recibido.
Mod_Declaraciones:
Option Compare Database Option Explicit
Public Const MF_CHECKED = &H8& Public Const MF_APPEND = &H100& Public Const TPM_LEFTALIGN = &H0& Public Const MF_DISABLED = &H2& Public Const MF_GRAYED = &H1& Public Const MF_SEPARATOR = &H800& Public Const MF_STRING = &H0& Public Const TPM_RETURNCMD = &H100& Public Const TPM_RIGHTBUTTON = &H2& Public Const MF_MENUID As Long = &H3F2 Public Const GWL_WNDPROC As Long = (-4) Public Const WM_SYSCOMMAND As Long = &H112 Public Const MF_POPUP = &H10&
Public Type POINTAPI X As Long Y As Long End Type
Public Declare Function CreatePopupMenu Lib "user32" () As Long Public Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal hwnd As Long, ByVal lptpm As Any) As Long Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Frm_Prueba_Menu:
Option Compare Database Option Explicit
Dim Menu, SubMenu
Private Function CreaMenu() SubMenu = CreatePopupMenu() AppendMenu SubMenu, MF_STRING, 1, "Item 1.1" AppendMenu SubMenu, MF_STRING, 2, "Item 1.2" AppendMenu SubMenu, MF_STRING, 3, "Item 1.3" Menu = CreatePopupMenu() AppendMenu Menu, MF_POPUP, SubMenu, "Item 1" 'CAST(UINT, SubMenu) End Function
Private Sub Form_Load() CreaMenu End Sub
Private Sub Comando0_Click() Dim PTr As POINTAPI Dim lngOpcion, lngOpcion1 GetCursorPos PTr lngOpcion = TrackPopupMenuEx(Menu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, PTr.X, PTr.Y, Me.hwnd, ByVal 0&) Select Case lngOpcion Case SubMenu Case 1 MsgBox "Seleccioné Item 1.1" Case 2 MsgBox "Seleccioné Item 1.2" Case 3 MsgBox "Seleccioné Item 1.3" End Select End Sub
-------------
pmv
|
Publicado por: Plinio Montano
Fecha de publicación: 17/Marzo/2025 a las 14:17
|
Se me fué un error al trancribir En las declaciones le puse un & de más al final de (Public Const MF_POPUP = &H10&), lo correcto es (Public Const MF_POPUP = &H10)
-------------
pmv
|
Publicado por: Plinio Montano
Fecha de publicación: 17/Marzo/2025 a las 23:25
|
Hola colegas.
Ante todo agradecer la atención que se preta siempre a las dudas que he presentado. Espero siempre estar a la altura de los objetivos y el bien hacer de este foro.
Les deseo bendiciones a todos los participantes.
Dado que mi duda ya se resolvió solicito formalmente que se cierre este hilo.
-------------
pmv
|
|