为什么 Delphi 进度条会增加迭代过程的执行时间？

Question

为什么使用进度条来显示迭代的进度会大大增加相关流程的执行时间？ 考虑以下示例：

procedure FileToStringList(FileName: String);
var
  fileSource: TStringList;
  I: Integer;
begin
  fileSource:= TStringList.Create;
  try
    fileSource.LoadFromFile(FileName);
    for I := 0 to fileSource.Count - 1 do
      begin
       //Code....
      end;
  finally
    fileSource.Free;
  end;
end;

如果添加进度条的更新：

procedure FileToStringList(FileName: String);
var
  fileSource: TStringList;
  I: Integer;
begin
  fileSource:= TStringList.Create;
  try
    fileSource.LoadFromFile(FileName);
    ProgressBar.Properties.Max:= fileSource.Count;
    for I := 0 to fileSource.Count - 1 do
      begin
        Application.ProcessMessages;
        ProgressBar.Position:= I;
      end;
  finally
    fileSource.Free;
  end;
end;

执行迭代过程所需的时间成倍增加。

对一个20万行的文件进行读取测试，不更新进度条，迭代时间约为8秒，但如果激活进度条更新显示迭代进度，这个过程需要几分钟。

一个2700行文件的测试，正常时间2-4秒，但使用进度条，执行时间超过1分钟。

有人可以指出应用程序进程消息的使用是否不正确吗？如果例程在一个单元中或在与进度条相同的窗体上，则结果不会改变。

好的，我可以看到 cmets，但是，有人可以通过示例或链接指出在这些情况下更新进度条的正确方法吗？

Answer 1

您并不是真的“只是添加了一个进度条”。您对Application.ProcessMessages; 消息的使用意味着您还可以在其他工作中发送各种其他消息。因此，现在您的“忙/主要工作”正在与通过您的应用程序的所有其他消息在同一线程（和 CPU）上竞争 CPU 时间。我们当然无法评论您的应用程序中可能会出现哪些其他消息。

繁忙的工作不应该在主线程中完成。如果方法与您的 GUI 耦合不是太紧密，将方法封装到线程中通常相当容易。

毫无疑问，你已经在 cmets 中被告知了这一切。

---

首先要注意几个重要的规则：

• 不要从您的子线程与您的 GUI 交互（同步或队列调用更新 GUI 的代码）；
• 避免在线程（包括主线程）之间共享数据¹；
• 如果您必须共享数据，请确保您的线程协调¹它们的访问权限以避免竞争条件（话题太大，无法详述）。

那么以下是最低要求：

1. 定义你的线程。
2. 在Execute() 方法中实现您的主要处理。
3. 创建并启动您的主题。
4. 由于您要更新进度条并记住“注意规则”：请确保将这些更新排队。

但是，您可以应用一些更高级的注意事项来改进您的线程。 （这些将留给您进一步研究。）

5. 建议您也接受Ive 和其他人已经给出的建议，并减少更新进度的次数。过多的更新只会浪费时间；尤其是跨线程操作（参见最后一节）。
6. 如果您的用户想要取消作业或关闭应用程序，您如何中断线程？
7. 您如何管理用户开始过多工作的可能性？
8. 您如何处理线程中的错误？
9. 您希望如何管理线程终止时发生的情况。

---

以下示例代码是您在 1-4 中所需内容的精简版。我漏掉的琐碎的部分你可以补上。

1)

type
  TFileProcessor = class(TThread)
  public
    constructor Create(const AFileName: string);
    procedure Execute; override;
  end;

2 & 4)

请注意，您可以在构造函数中传递进度条实例并从线程中更新它。但即使工作量更大，在你的线程上定义一个回调事件，并允许你的 GUI 处理事件以便准确地选择它想要做的事情。

procedure TFileProcessor.Execute;
var
  fileSource: TStringList;
  I: Integer;
begin
  fileSource:= TStringList.Create;
  try
    fileSource.LoadFromFile(FileName);
    { GUI interaction must be queued.
      ProgressBar.Properties.Max:= fileSource.Count;}
      FPosition := 0;
      FCount := fileSource.Count;
      Queue(DoUpdateProgress);
    for I := 0 to fileSource.Count - 1 do
      begin
        { Obviously this must go!
          Application.ProcessMessages;}
        { Again GUI interaction must be Queued
          ProgressBar.Position:= I;}
        FPosition := I;
        Queue(DoUpdateProgress); {TIP: Reduce your progress updates for 
                                  more performance improvement; updating 
                                  on every single line is overkill.}
      end;
  finally
    fileSource.Free;
  end;
end;

procedure TFileProcessor.DoUpdateProgress();
begin
  if Assigned(FOnUpdateProgress) then
    FOnUpdateProgress(FPosition, FCount);
end;

3)

procedure TForm1.Button1Click(...);
var
  LThread: TFileProcessor;
begin
  LThread := TFileProcessor.Create(FFileName);
  LThread.OnUpdateProgress := HandleUpdateProgress;
  LThread.FreeOnTerminate := True;
  LThread.Start;
end;

4)

如前所述，如果您的表单能够控制它想要更新的 GUI 控件以及如何响应进度更新，则会更简洁。例如。如果需要，您可以同时更新标签，而无需更改线程和作业代码。

procedure TForm1.HandleUpdateProgress(APosition, ACount: Integer);
begin
  ProgressBar.Position := APosition;
  ProgressBar.Properties.Max := ACount;
  Label1.Caption := Format('Line %d of %d', [APosition, ACount]);
end;

---

¹ 我想强调一点，您应该避免与多线程代码共享数据。跨线程操作比同线程操作要昂贵得多。 （这包括对主线程的通知。）

例如，在我的系统上，上面的线程代码有以下开销。

• 200,000 个排队事件到主线程的开销几乎为 1 秒。
• 根据您在HandleUpdateProgress 中所做的操作，您可能会发现在文件实际完成处理后一段时间内处理所有排队的消息需要一些时间。 （在我的系统上更新标准标签和进度条，这需要 5 秒。）

Answer 2

如果您的应用程序只转换输入文件，则不需要特殊线程，您可以使用以下代码。

如果应用程序允许用户在处理文件时执行其他操作，则应使用后台线程。

procedure FileToStringList(FileName: String);
var
   fileSource: TStringList;
   I,J: Integer;
begin
  fileSource:= TStringList.Create;
  try
    fileSource.LoadFromFile(FileName);
    ProgressBar.Properties.Max:= fileSource.Count;
    J:=10;//TODO make it better
    for I := 0 to fileSource.Count - 1 do
    begin
      if (I mod J = 0) then
      begin
        Application.ProcessMessages;
        ProgressBar.Position:= I;
      end;
    end;
    ProgressBar.Position:= fileSource.Count;
  finally
    fileSource.Free;
  end;
end;

或者您可以按时调用您的 processMessages：

procedure FileToStringList(FileName: String);
var
   fileSource: TStringList;
   I,J: Integer;
   lastCheck: TDateTime;
begin
  fileSource:= TStringList.Create;
  try
    fileSource.LoadFromFile(FileName);
    ProgressBar.Properties.Max:= fileSource.Count;
    J:=1000;//refresh in ms
    lastCheck:=now;
    for I := 0 to fileSource.Count - 1 do
    begin
      if (lastCheck+j)<now then
      begin
        lastCheck:=now;
        Application.ProcessMessages;
        ProgressBar.Position:= I;
      end;
    end;
    ProgressBar.Position:= fileSource.Count;
  finally
    fileSource.Free;
  end;
end;