Home » Pages » Visual Foxpro

RTF Control with inline shortcut menu

By Sergey - Posted on January 1st, 2008
Tagged:

The code below shows how to implement a shortcut menu in RTF control when user types '#' character into control. It uses code from Windows API support class and Pixels and Foxels.

This is sample code. Add error handling and adjust to your requirements as necessary.

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