VCL richedit，改变文字颜色很慢

Question

我在 delphi 程序（基于 VCL 的桌面应用程序）中有以下代码来遍历 richedit 中的文本行（大约 8-15 个单词之间的句子），找到所选用户的实例单词，然后为该单词 'red' 上色，如果它出现在一条线上。问题：如果程序必须处理超过几千行，则颜色更改进行得非常缓慢（几分钟过去了）。当光标四处乱舞时，我就坐在这里了。这是造成延迟的过程：

  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;

有人可以想出一个非常非常快的程序，或者告诉我如何解决问题吗？另外，如果您能用通俗易懂的语言解释缓慢的处理过程，那就太好了。（我只是一个爱好者）。

Answer 1

首先要做的是更改您的代码以使用 RichEdit 控件的 4.1 版（在 Windows XP SP1 中引入），仅此一项就可以加快速度。

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

Windows继续支持老版本的RichEdit控件，但是Delphi固执地继续使用老版本，具体见Vcl.ComCtrls.pas:

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

告诉Delphi使用WindowsXP时代的RichEdit 4.1

有几种方法可以解决这个问题；最少干扰的是创建一个新单元：

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.

然后将 MicrosoftEdit.pas 作为 last 单元包含在表单的 uses 的 interface 部分 子句。您甚至可以通过重新声明 TRichEdit 为您的新 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?

如果您要对 RichEdit 中的文本进行格式更改：

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

并且您有一个附加到 RichEdit 的 OnChange 处理程序，它会在每次格式更改时触发 OnChange。你需要阻止它：

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;

撤销

此外，您所做的每一次颜色更改都会记录在撤消列表中！以及每次 RichEdit 重绘。停止那些：

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;

有辅助函数：

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;

VCL richedit，改变文字颜色很慢

VCL richedit, slow to change word colors

delphi

richedit

告诉Delphi使用WindowsXP时代的RichEdit 4.1

OnChange?

撤销