Boton con menu deplegable

[Luis Gerardo]

Hace un tiempo solicite ayuda para armar un boton con un menu deplegable.

Me hicieron varias sugerencias, desde usar un objeto Microsoft Tool Bar 6.0 hasta un articulo publicado en la comunidad "Menú desplegable en un CommandButton"

Implemente el boton y funciona bastante bien dentro de un formulario, el problema que me surgio es que al tratar de poner ese boton en una clase Toolbar de VFP, el menu sale un poco desfasado (ver imagen), el codigo que utilizo es el siguiente:

lnRatio = Fontmetric(1)

lnY = (.Top + .Height) / lnRatio

lnRatio = Fontmetric(6)

lnX = .Left / lnRatio

If This.Parent.ParentClass = 'Form'

*!* Si esta dentro de un form *!*

Define Popup _Popup_Menu From lnY, lnX ShortCut

Else

Define Popup _Popup_Menu Relative From lnY, lnX ShortCut In Screen

EndIf

Si alguien tuviera alguna sugerencia para que no se viera tan desfasado, les agradeceria muchisimo.

[ZeRoberto]

A ver prueba este codigo

*-- Recursos obtenidos de la pagina https://comunidadvfp.blogspot.com/
If Not PemStatus(_Screen,"oMiToolBar",5)
   _Screen.AddProperty("oMiToolBar",Null)
EndIf
If IsNull(_Screen.oMiToolBar)
   _Screen.oMiToolBar = CreateObject("MiToolBar")
   _Screen.oMiToolBar.Dock(0)
   _Screen.oMiToolBar.Show
EndIf

Define Class MiToolBar As Toolbar
   *-- Propiedades
   Caption = "Saludo"
   ShowTips  = .T.
   ShowWindow = 1 && En formulario de nivel superior
   Name = "MiToolBar"
   *-- Objetos
   Add Object cmdEsp As CommandButton With ;
       Height = 24, Width = 32, ;
       Picture = Home(1) + "graphics\icons\flags\flgspain.ico", ;
       Caption = "", Name = "cmdEsp", ToolTipText = "Saludo"
   Add Object sep1 As Separator With ;
       Name = "sep1"
   Add Object cmdBra As CommandButton With ;
       Height = 24, Width = 32, ;
       Picture = Home(1) + "graphics\icons\flags\flgbrazl.ico", ;
       Caption = "", Name = "cmdBra", ToolTipText = "Saudação"
   Add Object cmdUSA As CommandButton With ;
       Height = 24, Width = 32, ;
       Picture = Home(1) + "graphics\icons\flags\flgusa02.ico", ;
       Caption = "", Name = "cmdUSA", ToolTipText = "Greet"
   Add Object cmdGer As CommandButton With ;
       Height = 24, Width = 32, ;
       Picture = Home(1) + "graphics\icons\flags\flggerm.ico", ;
       Caption = "", Name = "cmdGer", ToolTipText = "Grüß"
   *-- Metodos
   Procedure cmdEsp.Click
   Local lnLeft
      lnLeft = (ObjToClient(This.Parent, 2) + ObjToClient(This, 2)) / Fontmetric(6)
      ContextMenu(0, lnLeft)
   EndProc
   Procedure cmdBra.Click
      lnLeft = (ObjToClient(This.Parent, 2) + ObjToClient(This, 2)) / Fontmetric(6)
      ContextMenu(0, lnLeft)
   EndProc
   Procedure cmdUSA.Click
      lnLeft = (ObjToClient(This.Parent, 2) + ObjToClient(This, 2)) / Fontmetric(6)
      ContextMenu(0, lnLeft)
   EndProc
   Procedure cmdGer.Click    
      lnLeft = (ObjToClient(This.Parent, 2) + ObjToClient(This, 2)) / Fontmetric(6)
      ContextMenu(0, lnLeft)
   EndProc
EndDefine

Procedure ContextMenu(tnRow, tnCol)
   tnRow = Iif(Vartype(tnRow) == "N", tnRow, 0)
   tnCol = Iif(Vartype(tnCol) == "N", tnCol, 0)
   Define Popup ContextMenu ShortCut Relative From (tnRow), (tnCol) Shadow
   Define Bar 1 Of ContextMenu Prompt "\<Nuevo" PICTRES _Mfi_new
   Define Bar 2 Of ContextMenu Prompt "\<Abrir" PICTRES _Mfi_open
   Define Bar 3 Of ContextMenu Prompt "\-"
   Define Bar 4 Of ContextMenu Prompt "\<Guardar" PICTRES _Mfi_save
   Define Bar 5 Of ContextMenu Prompt "\<Imprimir" PICTRES _MFI_SYSPRINT
   Define Bar 6 Of ContextMenu Prompt "\<Enviar" PICTRES _Mfi_send
   Define Bar 7 Of ContextMenu Prompt "\-"
   Define Bar 8 Of ContextMenu Prompt "\<Salir" PICTRES _Mfi_quit
   Activate Popup ContextMenu
EndProc

Saludos

Ze

VFP Unlimited - Canal de Youtube

https://www.youtube.com/channel/UCkUIcHDsOdMUIdhYNO985JQ

--
Visita el Blog de la Comunidad Visual FoxPro en Español: http://comunidadvfp.blogspot.com
---
Has recibido este mensaje porque estás suscrito al grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/260a90e8-2a3a-4e59-a536-2bcd872fee46n%40googlegroups.com.

[ZeRoberto]

Revisa más la función ObjToClient() que te va a ayudar a resolver tu problema

Saludos

Ze

 

VFP Unlimited - Canal de Youtube

https://www.youtube.com/channel/UCkUIcHDsOdMUIdhYNO985JQ

El mié., 23 de sep. de 2020 a la(s) 13:16, Luis Gerardo (lg.ca...@gmail.com) escribió:

[Luis Gerardo]

Ze Roberto muchas gracias por el código, estuve analizándolo y me ayudo a hacer un poco mas estético el problema, ya que siendo un Objeto Toolbar, el menú no puede estar por encima de ese objeto, y como mi barra es horizontal, anclada al lado izquierdo, no es posible que el menú se muestre por encima, espero haberme explicado.

Creo que la mejor opcion va a ser crear un menu tipo arbol (como el que usa SAP) porque el sistema sigue creciendo y va a llegar el momento que no haya espacio suficiente.

Gracias nuevamente