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

yfjy0ee7  于 2022-11-29  发布在  其他
关注(0)|答案(2)|浏览(283)

我有100000行的TMemo。我想做这样的事情:

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没有帮助?

ogsagwnx

ogsagwnx1#

TStrings.BeginUpdate/EndUpdate只会禁止OnChangingOnChanged事件,对内容本身变更的内部行程没有影响。
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;

**注意:**一些注解提到在从备忘录复制内容或将内容复制到备忘录时使用Assign而不是Text属性:在这种情况下,Assign的速度明显较慢,这是因为TMemoLinesText属性进行了内部优化。此属性的Getter和Setter使用单个WM_GETTEXT/WM_SETTEXT消息直接访问Windows控件,而Assign使用每行一条EM_GETLINE消息进行阅读,并使用一系列EM_LINEINDEX、EM_SETSEL一个简单的计时测试表明,上面的代码大约需要600毫秒,而用Assign调用替换Text赋值需要11秒以上!

ru9i0ody

ru9i0ody2#

试验和结果:

{-------------------------------------------------------------------------------------------------------------
   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
-------------------------------------------------------------------------------------------------------------}


{ ListBox, adding 10000 items:
  61ms with BeginUpdate 
  1340ms without BeginUpdate }
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;

{ Memo.Lines: 1800ms 
  BeginUpdate makes no difference  }
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;


{ Memo.Lines.Add: 1900ms 
  BeginUpdate makes no difference }
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;

{ 1900ms | BeginUpdate makes no difference }
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;

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

  { ASSIGN: 1960ms | BeginUpdate makes no difference }
  btnClearMemoClick(Sender);
  TimerStart;
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Assign(TSL);
  Memo1.Lines.EndUpdate;
  Caption:= Caption+ '.    Assign: '+ TimerElapsedS;

  FreeAndNil(TSL);
end;

所以,乌维是对的。

相关问题