撤消

Question

我在delphi程序（基于VCL的桌面应用程序）中具有以下代码，以在richedit中遍历文本行（大约8-15个单词的句子），查找用户选择的单词的实例，然后为该单词着色单词“红色”应该出现在一行上。问题：如果该过程必须经过数千行，则变色的过程会非常缓慢（几分钟）。当光标在周围跳舞时，我坐在这里。这是造成延迟的过程：

  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使用Windows XP时代的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.

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

，并且您有一个OnChange处理程序附加到RichEdit，它会在每次格式更改时触发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，更改单词颜色的速度缓慢

1 个答案:

告诉Delphi使用Windows XP时代的RichEdit 4.1

OnChange？

撤消