Delphi中如何同步Parallel.For循环与进度条及完成提示？

嘿，这个问题我之前也碰到过，核心原因是你对任务进度的统计时机错了，加上UI更新的异步特性导致的。让我给你拆解一下问题和解决方案：

问题根源分析 #

1. 进度统计时机错误：你把TInterlocked.Increment(processed)放在了计算逻辑Calc之前，这意味着processed统计的是已经启动的任务数，而不是已经完成的任务数。当最后几个任务刚启动，进度条就被更新到100%，但这些任务的计算还在后台运行，所以进度条先填满，等所有计算真正结束后才弹出提示框。
2. 边界情况遗漏：如果总任务数不是10的倍数，最后几个完成的任务不会触发new mod 10 = 0的条件，导致进度条无法达到100%就弹出提示，同样会出现不同步。

修改后的代码方案 #

我调整了你的代码，修复了这两个问题，同时用更安全的方式更新UI：

调整后的Button1Click事件 #

procedure TForm1.Button1Click(Sender: TObject);
var n,m:integer;
begin
  ProgressBar1.Position:=0;
  n:=10;
  m:=100;
  SetLength(list,n*m);
  FTask := TTask.Create(
    procedure
    var processed: integer; // 统计已完成的任务数
    total : integer;
    begin
      processed := 0;
      total:=n*m;
      TParallel.For(1,total, procedure(Index: Integer)
      var new: integer;
      begin
        // 先执行计算，确保任务完成后再计数
        Calc(Index,Total);
        
        // 递增已完成任务的计数器
        new := TInterlocked.Increment(processed);
        
        // 每完成10个任务更新一次进度，减少UI线程压力
        if (new mod 10) = 0 then
        begin
          // 用TThread.Queue更新UI，线程安全且无需处理窗口句柄
          TThread.Queue(nil, 
            procedure
            begin
              ProgressBar1.Position := Round(new / total * 100);
            end);
        end;
      end);
      
      // 所有任务完成后，强制同步UI：先把进度条拉满，再触发完成提示
      TThread.Queue(nil,
        procedure
        begin
          ProgressBar1.Position := 100;
          AfterTest;
        end);
    end);
  FTask.Start;
end;

AfterTest过程保持不变 #

procedure TForm1.AfterTest;
begin
  FTask:=nil;
  ShowMessage('Finished');
end;

关键改进点说明 #

1. 修正计数时机：把Calc放在TInterlocked.Increment之前，确保进度条反映的是真正完成的任务进度，而不是已启动的任务数。
2. 用TThread.Queue替代PostMessage：避免了窗口句柄可能失效的问题（比如Form重建时Handle变化），而且直接在UI线程更新控件，更安全可靠。
3. 强制最终UI同步：在所有任务完成后，单独设置进度条为100%，然后再调用AfterTest，确保进度条填满和提示框弹出完全同步，同时解决了总任务数不是10的倍数时进度条无法拉满的问题。

额外建议 #

• 尽量避免在Parallel.For的循环体里频繁更新UI（比如每个任务都更新），保持每N个任务更新一次的节奏，减少UI线程的负担。
• 在Form销毁时，记得检查FTask是否还在运行，调用FTask.Cancel或者WaitFor(FTask)，避免内存泄漏或访问违规。

内容的提问来源于stack exchange，提问作者Hamed