VCL richedit, медленно менять цвета слов - PullRequest
Новая
       54

VCL richedit, медленно менять цвета слов

0 голосов
/ 20 февраля 2019

У меня есть следующий код в программе delphi (настольное приложение на основе VCL), чтобы перебирать строки текста (предложения примерно из 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;

Может кто-нибудь придумать процедуру, которая намного, намного быстрее, или посоветовать мне, как решить вопросы?Кроме того, если бы вы могли объяснить медленную обработку с точки зрения непрофессионала, это было бы замечательно.(Я всего лишь любитель).

1 Ответ

0 голосов
/ 29 марта 2019

Первое, что нужно сделать, это изменить свой код для использования версии 4.1 элемента управления RichEdit (представленной в 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.

и затем включение MicrosoftEdit.pas в качестве последнего юнитав разделе 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;

, и у вас есть обработчик 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;
...