处理大量行时，TMemo 速度非常慢答案

【问题标题】：TMemo is painfuly slow when working with large number of lines处理大量行时，TMemo 速度非常慢
【发布时间】：2017-10-28 14:46:20
【问题描述】：

我在 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 没有帮助？

【问题讨论】：

可怜的用户会滚动这样的备忘录。
PS：目前的解决方案是将这些行分配给一个TStringList，处理它们，然后将它们放回备忘录中。但我仍然很好奇为什么 BeginUpdate 不起作用。
@Victoria - 用户会将这些行放在那里。通常，我预计不到 100 行。我想测试一下 100000 会发生什么。这就是发生的事情。
这是一个 GUI 控件。它不是为文本处理而设计的。

标签： delphi delphi-xe7

【解决方案1】：

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

TMemo.Lines 由TMemoStrings 实现，它将文本内容存储在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;

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

【讨论】：

使用Assign() 方法而不是Text 属性：lst.Assign(Memo1.Lines); ... Memo1.Lines.Assign(lst); 由于这些行已经分开，只需按原样复制它们，不要连接它们只是为了重新解析它们，那是对内存和处理的浪费
@RemyLebeau，分别获取和设置每一行实际上是原始代码所做的。
我知道这一点。我指的是将备忘录内容复制到 StringList，然后再复制回来。你的回答说 Text 属性是做到这一点的“最有效”的方式，但这甚至不是真的，特别是对于 100000 行。 Text getter 执行 2-pass 扫描以分配和复制内存，然后 Text setter 解析输入以执行大量分配。另一方面，Assign() 执行的分配要少得多，并使用 1-pass 扫描。自己分析一下，Assign() 比Text 效率更高
@UweRaabe - 你能举一个开始/结束更新产生影响的例子吗？
@RemyLebeau，TStrings.Text 属性使用虚拟 GetTextStr 和 SetTextStr 方法，它们在 TMemoLines 中被覆盖。这些实现通过单个 WM_GETTTEXT 或 WM_SETTEXT 消息调用访问控件文本内容。我对其进行了测试，使用 Text 更快（比如 18 倍）。

【解决方案2】：

测试和结果：

{-------------------------------------------------------------------------------------------------------------
   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 是对的。

【讨论】：