Date: 02-16-2022
Return to Index
created by gbSnippets
'Primary Code:
'select the word
'change its color
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
'Compilable Example: (Jose Includes)
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "richedit.inc"
%IDC_RichEdit = 500
%IDC_ButtonA = 501
%IDC_ButtonB = 502
Global hDlg, hRichEdit As DWord
Function PBMain() As Long
Dim Content$
Content$ = "This ia a test of" + $CrLf + "highlighting more than one" + $CrLf + "word in a Rich Edit control"
Dialog New Pixels, 0, "HiLite Test",300,300,220,160, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_ButtonA, "HighLight", 10, 10, 90, 25
Control Add Button, hDlg, %IDC_ButtonB, "Un-HighLight", 110, 10, 90, 25
LoadLibrary("riched32.dll") : InitCommonControls
Control Add "RichEdit", hDlg, %IDC_RichEdit, Content$, 10, 40, 190, 100, _
%WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel, _
%WS_Ex_ClientEdge
Control Handle hDlg, %IDC_RichEdit To hRichEdit
SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local pd As CHARRANGE
Static Flag As Long
Select Case CB.Msg
Case %WM_InitDialog
Case %WM_Command
Select Case CB.Ctl
Case %IDC_ButtonA
Flag = 0
TurnOffColor
pd.cpMin = 0 : pd.cpMax = 4
SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd)) 'select something
SetColor %Blue
pd.cpMin = 15 : pd.cpMax = 31
Flag = 0
SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd)) 'select something
SetColor %Red
Flag = 0
SendMessage(hRichEdit, %EM_SETSEL, -1, 0) 'unselect all
Case %IDC_ButtonB
TurnOffColor
End Select
Case %WM_Notify
Select Case CB.NmID
Case %IDC_RichEdit
Select Case CB.Nmcode
Case %EN_SelChange
If Flag Then TurnOffColor
Flag = 1
End Select
End Select
End Select
End Function
Function SetColor(ByVal NewColor As Long) As Long 'set format of selected text
Local cf As CHARFORMAT
cf.cbSize = Len(cf) 'Length of structure
cf.dwMask = %CFM_COLOR + %CFM_Bold 'Set mask to colors only
cf.dwEffects = %CFE_Bold 'bold
cf.crTextColor = NewColor 'Set the new color value
SendMessage(hRichEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPTR(cf))
End Function
Sub TurnOffColor 'color all text to black/unbolded, with speed
Local cf As CHARFORMAT, xEvent As Long
xEvent = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0) 'Get eventmask
SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0) 'Disable eventmask
MousePTR 11 'Hourglass
cf.cbSize = Len(cf) 'Length of structure
cf.dwMask = %CFM_COLOR + %CFM_Bold 'Set mask to colors only
cf.dwEffects = &H0 'normal (optional)
cf.crTextColor = &H0 'Set black color value (optional)
SendMessage(hRichEdit, %EM_SETCHARFORMAT, -1, VarPTR(cf)) '%SCF_ALL = -1
If xEvent Then SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvent) 'Enable eventmask
MousePTR 0
End Sub
'gbs_01067
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm