TMemo 在处理大量行时非常缓慢

TMemo is painfuly slow when working with large number of lines

我在 TMemo 中有 100000 行。我想做类似的事情:

 for i:= 0 to Memo.Lines.Count-1 do
  Memo.Lines[i]:= SomeTrim(Memo.Lines[i]);

但是速度是每秒0.5行!!

添加 BeginUpdate/EndUpdate 后,我没有看到任何速度提升。

 Memo.Lines.BeginUpdate;
 for i:= 0 to Memo.Lines.Count-1 do
  Memo.Lines[i]:= SomeTrim(Memo.Lines[i]);
 Memo.Lines.EndUpdate;

我的问题是为什么 BeginUpdate/EndUpdate 没有帮助?

TStrings.BeginUpdate/EndUpdate只会禁止OnChangingOnChanged事件。它对内容本身更改的内部处理没有影响。

TMemo.LinesTMemoStrings 实现,它将文本内容存储在 Window 控件本身中。因此 BeginUpdate/EndUpdate 在这里毫无用处。

使用本地 TStringList 实例并使用 Text 属性 将数据从 TMemo 复制到 TStringList 可能会获得更好的结果然后回来。 Text 属性 是一次访问 TMemo 的全部内容的最有效方式。

  lst := TStringList.Create;
  try
    lst.Text := Memo1.Lines.Text;
    for I := 0 to lst.Count - 1 do begin
      lst[I] := SomeTrim(lst[I]);
    end;
    Memo1.Lines.Text := lst.Text;
  finally
    lst.Free;
  end;

注意: 一些评论提到在从和向备忘录复制内容时使用 Assign 而不是 Text 属性:由于 TMemoLines Text 属性 的内部优化,Assign 在这种情况下显着变慢。此 属性 的 Getter 和 Setter 使用单个 WM_GETTEXT/WM_SETTEXT 消息直接访问 Windows 控件,而 Assign 使用一个 EM_GETLINE 每行消息用于阅读,每行 EM_LINEINDEX、EM_SETSEL、EM_LINELENGTH 和 EM_REPLACESEL 序列用于写入。一个简单的计时测试表明,上面的代码需要大约 600 毫秒,而将 Text 赋值替换为 Assign 调用需要超过 11 秒!

测试和结果:

{-------------------------------------------------------------------------------------------------------------
   Conclusion 1:
       BeginUpdate has (a positive) effect ONLY if you add items one by one in a visual control (TMemo, TListBox)

   Conclusion 2:
       If you want to transfer the items from a TStringList to a TMemo, .Text is much faster than .Assign
-------------------------------------------------------------------------------------------------------------}



{ Inserting 10000 items
  61ms with BeginUpdate, 1340ms without }
procedure TfrmMain.btnInsertClick(Sender: TObject);
var
  I: Integer;
begin
  TimerStart;
  ListBox1.Items.BeginUpdate;
  TRY
    for I := 1 to StrToInt(Edit1.Text) do
      ListBox1.Items.Add(IntToStr(I));
  FINALLY
    ListBox1.Items.EndUpdate;
  END;

  Caption:= 'Inserting: '+ TimerElapsedS;
  Label3.Caption := 'Items : ' + IntToStr(ListBox1.Count);
end;


{ Same time with or without BeginUpdate.
  1800ms }
procedure TfrmMain.btnLinesClick(Sender: TObject);
begin
  btnClearMemoClick(Sender);
  TimerStart;

  Memo1.Lines.BeginUpdate;
  try
    Memo1.Lines := ListBox1.Items;
  finally
    Memo1.Lines.EndUpdate;
  end;

  Caption:= TimerElapsedS;
end;



{ Same time with or without BeginUpdate.
  1900ms }
procedure TfrmMain.btnLinesAddClick(Sender: TObject);
begin
  btnClearMemoClick(Sender);
  TimerStart;
  Memo1.Lines.BeginUpdate;
  try
    for VAR I := 0 to ListBox1.Items.Count - 1 do
      Memo1.Lines.Add(ListBox1.Items.Strings[I])
  finally
    Memo1.Lines.EndUpdate;
  end;
  Caption:= TimerElapsedS;
end;


{ Same time with or without BeginUpdate.
  1900ms }
procedure TfrmMain.btnAssignClick(Sender: TObject);
begin
  btnClearMemoClick(Sender);
  TimerStart;

  Memo1.Lines.BeginUpdate;
  try
    Memo1.Lines.Assign(ListBox1.Items);
  finally
    Memo1.Lines.EndUpdate;
  end;

  Caption:= TimerElapsedS;
end;


{ Fill a TStringList and assign it to the Memo }
procedure TfrmMain.btnTSLClick(Sender: TObject);
begin
  Caption:= '';

  { 0ms }
  btnClearMemoClick(Sender);
  TimerStart;
  VAR TSL:= TStringList.Create;
  for VAR I := 1 to 10000 do
    TSL.Add(IntToStr(i));
  Caption:= 'Create TSL: '+ TimerElapsedS;

  { 64ms with or without BeginUpdate }
  TimerStart;
  Memo1.Lines.BeginUpdate;
  Memo1.Text:= TSL.Text;
  Memo1.Lines.EndUpdate;
  Caption:= Caption+ '.    Text: '+ TimerElapsedS;

  { 1960ms with or without BeginUpdate }
  btnClearMemoClick(Sender);
  TimerStart;
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Assign(TSL);
  Memo1.Lines.EndUpdate;
  Caption:= Caption+ '.    Assign: '+ TimerElapsedS;

  FreeAndNil(TSL);
end;

所以,Uwe 是对的。