使用大量线路时,TMemo非常慢

时间:2017-10-28 14:46:20

标签: delphi delphi-xe7

我在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不会有帮助?

2 个答案:

答案 0 :(得分:10)

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属性:Assign的速度要慢得多这种情况是由于Text的{​​{1}}属性的内部优化所致。此属性的Getter和Setter使用单个WM_GETTEXT / WM_SETTEXT消息直接访问Windows控件,而TMemoLines每行使用一个EM_GETLINE消息进行读取,每行使用EM_LINEINDEX,EM_SETSEL,EM_LINELENGTH和EM_REPLACESEL序列进行写入。一个简单的时序测试表明上述代码需要大约600毫秒,而用Assign调用替换Text分配需要超过11秒!

答案 1 :(得分:0)

测试和结果:

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