Position Shortcut menu over Toolbar
The code below shows how to position a shortcut menu over a toolbar buttons using GetCursorPos function and ScreenToClient function
. The idea was provided by Andrey Davidoff on UT in the message #913121.
The code uses Windows API support class and Pix2Fox() UDF from Pixels and Foxels
.
Note 1When toolbar is docked on the right or bottom, the shortcut menu may be partially displayed outside of VFP desktop.
This is sample code. Add error handling and adjust to your requirements as necessary. |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 PUBLIC oTbr1 oTbr1 = NEWOBJECT("toolbar1") oTbr1.Dock(1) oTbr1.Show() RETURN FUNCTION GetCursorPos (tcPoint) DECLARE Long GetCursorPos IN WIN32API String @lpPoint RETURN GetCursorPos(@tcPoint) FUNCTION ScreenToClient(thWnd, tcPoint) DECLARE Long ScreenToClient IN WIN32API Long hWnd, String @lpPoint RETURN ScreenToClient(thWnd, @tcPoint) *------------------------------------------------------------------------------ * The idea was provided by Andrey Davidoff on UT in the message #913121 DEFINE CLASS toolbar1 AS toolbar Caption = "Toolbar1" Height = 28 Left = 0 Top = 0 Width = 63 Name = "mytoolbar" nSMCol = 0 nSMRow = 0 ADD OBJECT command1 AS commandbutton WITH ; Top = 3, Left = 5, Height = 22, Width = 23, ; Caption = "1", Name = "Command1" ADD OBJECT separator1 AS separator WITH ; Top = 3, Left = 35, Height = 0, Width = 0, ; Name = "Separator1" ADD OBJECT command2 AS commandbutton WITH ; Top = 3, Left = 35, Height = 22, Width = 23, ; Caption = "2", Name = "Command2" PROCEDURE CalculateShortcutMenuPosition() loWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp") lcPoint = REPLICATE(CHR(0), 8) * Get mouse location in Windows desktop coordinates (pixels) = GetCursorPos(@lcPoint) * Convert to VFP Desktop (_Screen) coordinates = ScreenToClient(_Screen.hWnd, @lcPoint) * Covert the coordinates to foxels This.nSMCol = Pix2Fox(loWas.Long2Num(LEFT(lcPoint,4)), .F., _Screen.FontName, _Screen.FontSize) This.nSMRow = Pix2Fox(loWas.Long2Num(RIGHT(lcPoint,4)), .T., _Screen.FontName, _Screen.FontSize) ENDPROC PROCEDURE command1.RightClick This.Parent.CalculateShortcutMenuPosition() DEFINE POPUP myshortcut shortcut FROM This.Parent.nSMRow, This.Parent.nSMCol DEFINE BAR 1 OF myshortcut PROMPT "Menu Item 1-1" DEFINE BAR 2 OF myshortcut PROMPT "Menu Item 2-1" DEFINE BAR 3 OF myshortcut PROMPT "Menu Item 3-1" DEFINE BAR 4 OF myshortcut PROMPT "Menu Item 4-1" DEFINE BAR 5 OF myshortcut PROMPT "Menu Item 5-1" ACTIVATE POPUP myshortcut ENDPROC PROCEDURE command2.RightClick This.Parent.CalculateShortcutMenuPosition() DEFINE POPUP myshortcut shortcut FROM This.Parent.nSMRow, This.Parent.nSMCol DEFINE BAR 1 OF myshortcut PROMPT "Menu Item 1-2" DEFINE BAR 2 OF myshortcut PROMPT "Menu Item 2-2" DEFINE BAR 3 OF myshortcut PROMPT "Menu Item 3-2" DEFINE BAR 4 OF myshortcut PROMPT "Menu Item with longer Prompt" ACTIVATE POPUP myshortcut ENDPROC ENDDEFINE
Comments
Autohide this
Can we autohide this shortcut menu? If yes, how can this be done.
Right-click shortcurt menu
Does not work if 125% Display zoom active
This Code does not work correctly if i choose 125% Text zoom (Control Panel\Appearance\Display).
The Menu doesn't appear at the Mouse Pointer. Do you have an solution for this?
Greetings from Germany
Jörg
Re: Does not work if 125% Display zoom active
I tested the code under Windows XP and Windows 7 with 125% zoom and it works correctly.