Date: 02-16-2022
Return to Index
created by gbSnippets
'Primary Code:
'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
Local Content$, cName$, style&
Style& = %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
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
If LoadLibrary("msftedit.dll") Then
cName$ = "RichEdit50W"
ElseIf LoadLibrary("riched20.dll") Then
cName$ = "RichEdit20A"
ElseIf LoadLibrary("riched32.dll") Then
cName$ = "RichEdit"
End If
Dialog Set Text hDlg, "Multiple Selections"
InitCommonControls
Control Add cName$, hDlg, %IDC_RichEdit, Content$, 10, 40, 190, 100, style&, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_RichEdit To hRichEdit
SendMessage hRichEdit, %EM_SetEventMask, 0, %ENM_SelChange
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
PostMessage(hRichEdit, %EM_SETSEL, -1, 0) 'unselect all
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_ButtonA
Flag = 1
TurnOffColor
pd.cpMin = 15 : pd.cpMax = 17
SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd)) 'select something
SetColor %Red, %Yellow
pd.cpMin = 45 : pd.cpMax = 49
SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd)) 'select something
SetColor %Red, %Yellow
SendMessage(hRichEdit, %EM_SETSEL, -1, 0) 'unselect all
Flag = 0
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 Exit Select
Flag = 1 : TurnOffColor : Flag = 0
End Select
End Select
End Select
End Function
Function SetColor(FG As Long, BG As Long) As Long 'set format of selected text
Local cf As CHARFORMAT2
cf.cbSize = Len(cf) 'Length of structure
cf.dwMask = %CFM_BackColor + %CFM_COLOR + %CFM_Bold 'Set mask to colors only
cf.dwEffects = %CFE_Bold 'bold
cf.crTextColor = FG
cf.crBackColor = BG
SendMessage(hRichEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPtr(cf))
End Function
Sub TurnOffColor 'color all text to black/unbolded, with speed
Local cf As CHARFORMAT2, 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_BackColor + %CFM_COLOR + %CFM_Bold 'Set mask to colors only
cf.dwEffects = &H0 'normal (optional)
cf.crTextColor = &H0 'Set black color value (optional)
cf.crBackColor = %White
SendMessage(hRichEdit, %EM_SETCHARFORMAT, %SCF_All, VarPtr(cf))
If xEvent Then SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvent) 'Enable eventmask
MousePTR 0
End Sub
'gbs_01068
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm