Multiple RichEdit "Selections" II

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'Primary Code:
 
'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
   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 LongAs 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


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