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



PUBLIC oform1
oForm1=NEWOBJECT("form1")
oForm1.Show
RETURN

DEFINE CLASS form1 AS form

	Top = 0
	Left = 0
	Height = 355
	Width = 551
	Caption = "RTF inline shortcut menu"
	AllowOutput = .F.
	Name = "Form1"

	oWas = NULL

	ADD OBJECT ortf AS olecontrol WITH ;
		Top = 12, Left = 11, Height = 288, Width = 528, ;
		OleClass = "Richtext.RichtextCtrl.1", Name = "oRtf"

	PROCEDURE ortf.SelChange
		*** ActiveX Control Event ***
		* SelChange Event
		* SelLength = 0 - Nothing selected
		IF THIS.SelLength = 0  AND SUBSTR(This.text, This.SelStart, 1) = "#"	 
			* Get current position of the caret relative to the RTF control window
			lcPoint = REPLICATE(CHR(0), 8)
			= GetCaretPos(@lcPoint)
			* Extract X and Y positions in pixels
			WITH Thisform.oWas
				lnXpix = .Long2Num(LEFT(lcPoint,4))
				lnYpix = .Long2Num(RIGHT(lcPoint,4))
			ENDWITH	
			* Adjust positions to make it relative to the _SCREEN
			lnYpos = Thisform.Top + SYSMETRIC(4) + SYSMETRIC(9) + This.Top + lnYpix + FONTMETRIC(1, This.Font.Name, This.Font.Size)
			lnXPos = Thisform.Left + SYSMETRIC(3) + SYSMETRIC(12) + This.Left + lnXpix
			* Convert to foxels for shortcut menu
			lnRow = pix2fox(lnYpos, .T.,_screen.Fontname ,_screen.FontSize) 
			lnCol = pix2fox(lnXPos, .F.,_screen.Fontname ,_screen.FontSize)
		        
			* Save Current settings for selected text
			lnSelStart     = This.SelStart

			* Show shortcut menu
			DEFINE POPUP sm SHORTCUT RELATIVE FROM (lnRow), (lnCol)
			DEFINE BAR 1 OF sm PROMPT "Open" 
			DEFINE BAR 2 OF sm PROMPT "Closed" 
			ON SELECTION BAR 1 of sm lcText = PROMPT()
			ON SELECTION BAR 2 of sm lcText = PROMPT()

			lcText = "#"
			ACTIVATE POPUP sm
			IF NOT (lcText == "#")
				* replace '#" with selected text
				This.SelStart  = lnSelStart - 1
				This.SelLength = 1
				This.SelText   = lcText
				* Put caret after inserted text and remove selections
				This.SelStart  = lnSelStart + LEN(lcText) - 1
				This.SelLength = 0 
			ENDIF
		ENDIF
	ENDPROC

	PROCEDURE Load
			DECLARE GetCaretPos IN WIN32API String @ Point
			This.oWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")
	ENDPROC

ENDDEFINE