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
只会禁止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;
注意: 一些评论提到在从和向备忘录复制内容时使用 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 是对的。
我在 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
只会禁止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;
注意: 一些评论提到在从和向备忘录复制内容时使用 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 是对的。