VCL richedit, slow to change word colors

Question

I have the following code in a delphi program (VCL based desktop application) to iterate through lines of text (sentences of between about 8-15 words) in a richedit, find instances of a user selected word, and then color that word 'red' should it appear on a line. The problem: The color changing proceeds painfully slowly (several minutes elapse) if the procedure must work through more than a few thousand lines. I'm left sitting here while the cursor dances around. Here's the procedure that is the source of the delay:

  procedure Color_Words(RE: TRichEdit; Word: String; Color: TColor);
  var
     i, startPos, CharPos2, nosChars: Integer;
  begin
     startPos := 0;
     nosChars := 0;
     charpos2:=0;
     RE.lines.beginupdate;
     for i := 0 to Pred(RE.Lines.Count) do
     begin
        nosChars := nosChars + Length(RE.Lines[i]);
        CharPos2 := RE.FindText(word, startPos,nosChars,stmatchcase]);
        startPos := CharPos2+1;
        RE.SelStart := CharPos2;
        RE.SelLength :=(Length(word));
        RE.SelAttributes.Color := Color;
     end;
     RE.Lines.EndUpdate;               
  end;

Can someone come up with a procedure that is much, much quicker, or advise me how to solve matters? Also, if you could explain the slow processing in layman's terms that would be wonderful. (I am but a hobbyist).

Answer 1

First thing to do is change your code to use the version 4.1 of RichEdit control (introduced with Windows XP SP1), that alone might speed things up.

• "RichEdit20W": Riched20.dll (Windows 98)
• "RICHEDIT50W": Msftedit.dll (Windows XP SP1)

Windows continues to support the older versions of the RichEdit control, but Delphi stubbornly continues to use the old version, as you can see in Vcl.ComCtrls.pas:

procedure TCustomRichEdit.CreateParams(var Params: TCreateParams);
const
   RichEditClassName = 'RICHEDIT20W';
begin
   inherited CreateParams(Params);
   CreateSubClass(Params, RichEditClassName); //<-- 'RICHEDIT20W'
   //...
end;

Tell Delphi to use the Windows XP era RichEdit 4.1

There are a couple ways to fix this; the least intrusive is to create a new unit:

MicrosoftEdit.pas

unit MicrosoftEdit;

interface

uses
    Vcl.ComCtrls, Winapi.RichEdit, Vcl.Controls, Winapi.Windows, System.Classes;

type
    TRichEdit = class(Vcl.ComCtrls.TRichEdit)
    protected
        procedure CreateParams(var Params: TCreateParams); override;
    end;

implementation

{ TMicrosoftEdit }

procedure TRichEdit.CreateParams(var Params: TCreateParams);
const
    MSFTEDIT_CLASS = 'RICHEDIT50W'; //Richedit 4.1, Msftedit.dll
begin
    LoadLibrary('msftedit.dll');

    inherited CreateParams({var}Params);

    CreateSubClass({var}Params, MSFTEDIT_CLASS); //"RICHEDIT50W"
end;

end.

And then include MicrosoftEdit.pas as the last unit in the interface section of your form's uses clause. And you can even be doubly sure that it works by re-declaring TRichEdit to be your new TRichEdit:

unit MyForm;

uses
   Forms, RichEdit, MicrosoftEdit;

type
    TRichEdit = MicrosoftEdit.TRichEdit; //use our own TRichEdit

    TMyForm = class(TForm)
       RichEdit1: TRichEdit;
    private
    protected
    public
    end;
 //...

OnChange?

If you are making formatting changes to the text in a RichEdit:

procedure TMyForm.Button1Click(Sender: TObject);
begin
   Color_Words(RichEdit1, 'Trump', clRed);
end;

and you have an OnChange handler attached to the RichEdit, it will fire the OnChange every time the formatting changes. You need to stop that:

procedure TMyForm.Button1Click(Sender: TObject);
var
   oldOnChange: TNotifyEvent;
begin
   oldOnChange := RichEdit1.OnChange;
   RichEdit1.OnChange := nil;
   try
      Color_Words(RichEdit1, 'Trump', clRed);
   finally 
      RichEdit1.OnChange := oldOnChange;  
   end;
end;

Undos

In addition, every coloring change you make will be recorded in the Undo list! As well as the RichEdit redrawing every time. Stop those:

procedure TMyForm.Button1Click(Sender: TObject);
var
   oldOnChange: TNotifyEvent;
begin
   oldOnChange := RichEdit1.OnChange;
   RichEdit1.OnChange := nil;
   try
      RichEditSuspendAll(RichEdit1, True);
      try         
         Color_Words(RichEdit1, 'Trump', clRed);
      finally 
         RichEditSuspendAll(RichEdit1, False);   
      end;
   finally 
      RichEdit1.OnChange := oldOnChange;  
   end;
end;

With a helper function:

procedure RichEditSuspendAll(ARichEdit: TRichEdit; bSuspend: Boolean);
var
   doc: ITextDocument;
   re: IUnknown;

begin
   {
       http://bcbjournal.org/articles/vol3/9910/Faster_rich_edit_syntax_highlighting.htm

      int eventMask = ::SendMessage(RichEdit1->Handle, EM_SETEVENTMASK, 0, 0);
      SendMessage(RichEdit1->Handle, WM_SETREDRAW, false, 0);
      ParseAllText(RichEdit1);
      SendMessage(RichEdit1->Handle, WM_SETREDRAW, true, 0);
      InvalidateRect(RichEdit1->Handle, 0, true);
      SendMessage(RichEdit1->Handle, EM_SETEVENTMASK, 0, eventMask);
   }

{
    http://support.microsoft.com/KB/199852
    How To Suspend and Resume the Undo Functionality in Richedit 3.0

    If it is necessary to Undo an action that is performed before a suspend, after resuming the Undo, then,
    tomFalse must be replaced with "tomSuspend" and tomTrue must be replaced with "tomResume".
    This method retains the contents of the Undo buffer even when Undo is suspended.

    Applications can retrieve an ITextDocument pointer from a rich edit control.
    To do this, send an EM_GETOLEINTERFACE message to retrieve an IRichEditOle
    object from a rich edit control. Then, call the object's
    IUnknown::QueryInterface method to retrieve an ITextDocument pointer.
}
   if ARichEdit = nil then
      raise Exception.Create('ARichEdit is nil');
   if SendMessage(ARichEdit.Handle, EM_GETOLEINTERFACE, 0, LPARAM(@re)) = 0 then
      raise Exception.Create('Could not get OleInterface from RichEdit');

   doc := re as ITextDocument;

   doc := RichEditGetTextDocument(ARichEdit);
   if bSuspend then
   begin
      RichEdit.Perform(WM_SETREDRAW, 0, 0);  //disable all painting of the control
      doc.Undo(Integer(tomSuspend)); // Suspends Undo.
   end
   else
   begin
      doc.Undo(Integer(tomResume)); // Resumes Undo.
      RichEdit.Perform(WM_SETREDRAW, 0, 0);  //disable all painting of the control
   end;
end;