Position Shortcut menu over Toolbar

Submitted by Sergey on January 23, 2009 - 15:38 UTC
topic: 
code
vfp
winapi
menu

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 1

When 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

Submitted by Sanjay Karia on February 21, 2009 - 11:35 UTC
Thanks for this Shortcut menu. It is really nice.
Can we autohide this shortcut menu? If yes, how can this be done.

Submitted by Sergey on February 21, 2009 - 20:24 UTC
The whole point of right-click shortcut menu is to let user to choose something. If you want to give a user way out of menu, add 'Cancel' option.

Submitted by Joerg Schneider on March 7, 2011 - 13:09 UTC
Hi!
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

Submitted by Sergey on March 7, 2011 - 13:42 UTC
Hi Jörg,

I tested the code under Windows XP and Windows 7 with 125% zoom and it works correctly.