Change VFP Object Font Style using MSComDlg

First we need "Microsoft Common Dialog Control" ActiveX. Drop it into your form, now we can use all FontStyle capability from it.

As usual, we need to reflect the FontStyle from our object to be display in Font Dialog at first. You can do it from CommonDialog init event or directly from the function/method if you want to be able to change several object with different style.

Here is the example using several object, just copy and paste it into a prg then run it.
Enjoy!

Thanks to:
Chris R. Chamberlain for giving me an idea to make this FAQ


[color green]**************************************************[/color]
DEFINE CLASS form1 AS form

#Define CC_RGBINIT 0x0001
#Define CC_FULLOPEN 0x0002
#Define CF_BOTH 0x0003 [color green]&& Screen and Printer Fonts[/color]
#Define CF_EFFECTS 0x0100

Top = 0
Left = 0
Height = 233
Width = 400
DoCreate = .T.
ShowTips = .T.
Caption = "Form1"
Name = "Form1"

ADD OBJECT edit1 AS editbox WITH ;
Height = 140, ;
Left = 18, ;
Value = "Right Click to change the FontStyle, " + ;
"Double Click to change Color", ;
Top = 12, ;
Width = 179, ;
Name = "Edit1"

ADD OBJECT edit2 AS editbox WITH ;
Height = 140, ;
Left = 203, ;
Value = "Right Click to change the FontStyle, " + ;
"Double Click to change Color", ;
Top = 12, ;
Width = 179, ;
Name = "Edit2"

ADD OBJECT text1 AS textbox WITH ;
Height = 23, ;
Left = 32, ;
Value = "Right Click to change the FontStyle, " + ;
"Double Click to change Color", ;
Top = 166, ;
Width = 336, ;
IntegralHeight = .T., ;
Name = "Text1"

ADD OBJECT OleControl1 AS olecontrol WITH ;
Top = 11, ;
Left = 149, ;
Height = 100, ;
Width = 100, ;
OLEClass = "MSComDlg.CommonDialog.1", ;
Name = "OleControl1"


PROCEDURE ChangeFont
LParameters toRef
Local ll_Cancel, lc_OldError

With ThisForm.OleControl1
[color green]** Set Font Dialog to reflect the last Object Style[/color]
.FontName = toRef.FontName
.FontSize = toRef.FontSize
.FontBold = toRef.FontBold
.FontStrikeThru = toRef.FontStrikeThru
.FontUnderline = toRef.FontUnderline
.FontItalic = toRef.FontItalic
[color green]* .Color = toRef.ForeColor[/color]

.Flags = CF_BOTH + CF_EFFECTS
lc_OldError = on('error')
On error ll_Cancel = .T.
.ShowFont()
On error &lc_OldError

If !ll_Cancel
[color green]** Set FontStyle to Object[/color]
toRef.FontName = .FontName
toRef.FontSize = .FontSize
toRef.FontBold = .FontBold
toRef.FontStrikeThru = .FontStrikeThru
toRef.FontUnderline = .FontUnderline
toRef.FontItalic = .FontItalic
[color green]* toRef.ForeColor = .Color[/color]
endif
EndWith
ENDPROC


PROCEDURE ChangeColor
LParameters toRef
Local ll_Cancel, lc_OldError

With ThisForm.OleControl1
.Color = toRef.ForeColor
.Flags = CC_RGBINIT + CC_FULLOPEN

ll_Cancel = .F.
lc_OldError = on('error')
On error ll_Cancel = .T.
.ShowColor()
On error &lc_OldError

If !ll_Cancel
toRef.ForeColor = .Color
endif
EndWith
ENDPROC


PROCEDURE edit1.RightClick
ThisForm.ChangeFont(This)
ENDPROC

PROCEDURE edit1.DblClick
ThisForm.ChangeColor(This)
ENDPROC


PROCEDURE edit2.RightClick
ThisForm.ChangeFont(This)
ENDPROC

PROCEDURE edit2.DblClick
ThisForm.ChangeColor(This)
ENDPROC


PROCEDURE text1.RightClick
ThisForm.ChangeFont(This)
ENDPROC

PROCEDURE text1.DblClick
ThisForm.ChangeColor(This)
ENDPROC


PROCEDURE OleControl1.Init
This.CancelError = .T.
ENDPROC

ENDDEFINE
[color green]*
*-- EndDefine: form1
**************************************************[/color]