Delphi循环速度问题

Bra*_*rad 5 delphi performance loops for-loop

有更快的方法吗?我基本上需要一次将AA-ZZ添加到数千条记录中.

只需要35个项目的列表就需要很长时间才能完成一千个列表.


procedure Tmainform.btnSeederClick(Sender: TObject);
var
  ch,ch2:char;
  i:integer;
  slist1, slist2:TStrings;
begin
  slist1:= TStringList.Create;
  slist2:= TStringList.Create;
  slist1.Text :=queuebox.Items.Text;
  for ch := 'a' to 'z' do
    begin
      for ch2 := 'a' to 'z' do
        begin
          //

for I := 0 to slist1.Count - 1 do begin application.ProcessMessages; // so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all. sleep(1); //Without this it doesn't process the cancel button. if cancel then Break; slist2.Add(slist1.Strings[i]+ch+ch2); end; end; end; insertsingle(slist2,queuebox); freeandnil(slist1); freeandnil(slist2);
Run Code Online (Sandbox Code Playgroud)

结束;

谢谢你的帮助

Mas*_*ler 14

您的代码有几个明显的问题.

首先,你浪费了很多CPU周期,一遍又一遍地计算相同的值.AA..ZZ值不会改变,所以不需要一遍又一遍地构建它们.尝试这样的事情:创建第三个TStringList.通过双循环完成所有可能的AA..ZZ排列.一旦结束,循环并合并此预先计算的字符串列表中的值slist1.你应该看到一个相当大的推动力.

(或者,如果时间绝对非常宝贵,请编写一个小程序,计算排列列表并将其保存到文本文件中,然后将其作为字符串资源编译到您的应用程序中,您可以在运行时加载它.)

其次,这可能是什么在扼杀你,你不应该在最里面的循环中使用ProcessMessages和Sleep调用. Sleep(1);听起来它意味着"睡眠1毫秒",但Windows并没有提供那种精确度.你最终得到的是"睡眠至少 1毫秒".它会释放CPU,直到Windows重新启动它,通常大约为16毫秒.因此,您需要将16毫秒的延迟(加上ProcessMessages所需的时间)添加到一个非常紧凑的循环中,执行其余代码可能只需几微秒.

如果你需要这样的东西来保持UI响应,它应该在最外层的循环中,而不是内层循环中,你甚至可能不需要每次迭代都运行它.尝试类似的东西if ch mod 100 = 0 then //sleep and process messages here.Craig建议将这个任务转移到一个工作线程也会有所帮助,但前提是你对线程有足够的了解才能做到正确.他们可能很棘手.


Blo*_*ard 11

您应该使用slist2.BeginUpdate()和包围代码slist2.EndUpdate(),以阻止TStringList进行额外处理.

根据我的经验,如其他答案所示,通过使用较少的语句,您将获得非常大的改进ProcessMessages(); Sleep(1);.

尝试将它移动到第一个for循环的下方,看看你得到了什么改进.


Lie*_*ers 5

一个如何使用secundary线程来完成繁重工作的示例.

请注意,对于您提到的35个项目,启动另一个线程真的不值得.对于几千件物品,游戏会发生变化.在桌面计算机上处​​理10.000项需要10秒.

多线程的一些好处:

  • 主线程保持响应.
  • 计算可以随意停止.

和一些陷阱:

  • 必须注意(在当前的实现中)在播种运行时不要弄乱传递的字符串列表.
  • 多线程增加了复杂性,并且是难以发现错误的根源.

在我们最喜欢的编辑器中粘贴下面的代码,你应该很高兴.

procedure TForm1.btnStartClick(Sender: TObject);
var
  I: Integer;
begin
  //***** Fill the sourcelist
  FSource := TStringList.Create;
  FDestination := TStringList.Create;
  for I := 0 to 9999 do
    FSource.Add(Format('Test%0:d', [I]));

  //***** Create and fire Thread
  FSeeder := TSeeder.Create(FSource, FDestination);
  FSeeder.OnTerminate := DoSeederDone;
  FSeeder.Resume;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  if Assigned(FSeeder) then
    FSeeder.Terminate;
end;

procedure TForm1.DoSeederDone(Sender: TObject);
var
  I, step: Integer;
begin
  I := 0;
  step := 0;
  while I < FDestination.Count do
  begin
    //***** Don't show every item. OutputDebugString is pretty slow.
    OutputDebugString(PChar(FDestination[I]));
    Inc(step);
    Inc(I, step);
  end;
  FSource.Free;
  FDestination.Free;
end;

{ TSeeder }

constructor TSeeder.Create(const source, destination: TStringList);
begin
  //***** Create a suspended, automatically freed Thread object.
  Assert(Assigned(source));
  Assert(Assigned(destination));
  Assert(destination.Count = 0);
  inherited Create(True);
  FreeOnTerminate := True; //***** Triggers the OnTerminate event
  FSource := source;
  FDestination := destination;
end;

procedure TSeeder.Execute;
var
  I, J: Integer;
  AString: string;
begin
  FDestination.BeginUpdate;
  try
    FDestination.Capacity := FSource.Count * 26 * 26;
    for I := 0 to Pred(FSource.Count) do
    begin
      AString := FSource[I];
      for J := 0 to Pred(26 * 26) do
      begin
        FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
        if Terminated then Exit;
      end;
    end;
  finally
    FDestination.EndUpdate;
  end;
end;
Run Code Online (Sandbox Code Playgroud)


Jer*_*ers 4

好的。我已经尝试优化你的代码。对于最终测试,需要一些测试数据。

我所做的(其中包括梅森的大部分想法):

  • 注释掉有关“取消”和“的代码
  • 给类型和变量一个更有意义的名称
  • 使用 Delphi 使用的名称(“Application”而不是“application”等)以使其可读
  • 将一些逻辑移入“KeepUIGoing”
  • 将后缀的计算从主循环移到初始化循环中
  • 使其可以选择使用 TStringBuilder(它比 TStringList 快得多,并且自 Delphi 2009 起可用)

以下是修改后的代码,请告诉我它是否适合您。

procedure TForm2.Button1Click(Sender: TObject);
{$define UseStringBuilder}
  procedure KeepUIGoing(SourceListIndex: Integer);
  begin
    if SourceListIndex mod 100 = 0 then
    begin
      Application.ProcessMessages;
      // so it doesn't freeze the application in long loops.  Not 100% sure where this should be placed, if at all.
      Sleep(1);
    end;
  end;
const
  First = 'a';
  Last = 'z';
type
  TRange = First .. Last;
  TSuffixes = array [TRange, TRange] of string;
var
  OuterIndex, InnerIndex: Char;
  SourceListIndex: Integer;
  SourceList, TargetList: TStrings;
  Suffixes: TSuffixes;
  NewLine: string;
{$ifdef UseStringBuilder}
  TargetStringBuilder: TStringBuilder; // could be way faster than TStringList
{$endif UseStringBuilder}
begin
  for OuterIndex := First to Last do
    for InnerIndex := First to Last do
      Suffixes[OuterIndex, InnerIndex] := OuterIndex + InnerIndex;

  SourceList := TStringList.Create;
  TargetList := TStringList.Create;
{$ifdef UseStringBuilder}
  TargetStringBuilder := TStringBuilder.Create();
{$endif UseStringBuilder}
  try
    SourceList.Text := queuebox.Items.Text;
    for OuterIndex := First to Last do
    begin
      for InnerIndex := First to Last do
      begin
        for SourceListIndex := 0 to SourceList.Count - 1 do
        begin
          KeepUIGoing(SourceListIndex);
          // if cancel then
          // Break;
          NewLine := SourceList.Strings[SourceListIndex] + Suffixes[OuterIndex, InnerIndex];
{$ifdef UseStringBuilder}
          TargetStringBuilder.AppendLine(NewLine);
{$else}
          TargetList.Add(NewLine);
{$endif UseStringBuilder}
        end;
      end;
    end;
{$ifdef UseStringBuilder}
    TargetList.Text := TargetStringBuilder.ToString();
{$endif UseStringBuilder}
    // insertsingle(TargetList, queuebox);
  finally
{$ifdef UseStringBuilder}
    FreeAndNil(TargetStringBuilder);
{$endif UseStringBuilder}
    FreeAndNil(SourceList);
    FreeAndNil(TargetList);
  end;
end;
Run Code Online (Sandbox Code Playgroud)

——杰罗恩