Crear Menu con SubMenú usando APIs

   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
	     - Item 1.2
	     - Item 1.3
...
...

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

Autor	Mensaje Tema Buscar Opciones del Tema Responder Crear un nuevo tema Versión imprimible Traducir Tema
Plinio Montano Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 10/Marzo/2015 Localización: Cuba Estado: Sin conexión Puntos: 169	Tema: Crear Menu con SubMenú usando APIs Enviado: 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 - Item 1.2 - Item 1.3 ... ... 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

Plinio Montano Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 10/Marzo/2015 Localización: Cuba Estado: Sin conexión Puntos: 169	Enviado: 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

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 15/Marzo/2025 a las 09:07
	Ahí falta rutinas / código pOr poner ¿NO?
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

Plinio Montano Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 10/Marzo/2015 Localización: Cuba Estado: Sin conexión Puntos: 169	Enviado: 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 Item 1.2 Item 1.3 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

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 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. Access Aplicaciones Tecsys.es

Plinio Montano Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 10/Marzo/2015 Localización: Cuba Estado: Sin conexión Puntos: 169	Enviado: 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

Plinio Montano Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 10/Marzo/2015 Localización: Cuba Estado: Sin conexión Puntos: 169	Enviado: 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

Plinio Montano Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 10/Marzo/2015 Localización: Cuba Estado: Sin conexión Puntos: 169	Enviado: 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