Multiple RichEdit "Selections" I

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'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:
#Compiler PBWin 10
#Compile EXE
#Dim All
#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 LongAs 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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm