使用 Delphi XE7 并行库

Question

我想使用 Delphi XE7 的新并行库并行处理一个耗时的例程。

这里是单线程版本：

procedure TTerritoryList.SetUpdating(const Value: boolean);
var
  i, n: Integer;
begin
  if (fUpdating <> Value) or not Value then
  begin
    fUpdating := Value;

    for i := 0 to Count - 1 do
    begin
      Territory[i].Updating := Value; // <<<<<< Time consuming routine
      if assigned(fOnCreateShapesProgress) then
        fOnCreateShapesProgress(Self, 'Reconfiguring ' + Territory[i].Name, i / (Count - 1));
    end;
  end;
end;

真的没有什么复杂的事情发生。如果更改了区域列表变量或将其设置为 false，则例程会循环所有销售区域并重新创建区域边界（这是一项耗时的任务）。

所以这是我尝试使其平行：

procedure TTerritoryList.SetUpdating(const Value: boolean);
var
  i, n: Integer;
begin
  if (fUpdating <> Value) or not Value then
  begin
    fUpdating := Value;

    n := Count;
    i := 0;

    TParallel.For(0, Count - 1,
      procedure(Index: integer)
      begin
        Territory[Index].Updating := fUpdating; // <<<<<< Time consuming routine
        TInterlocked.Increment(i);
        TThread.Queue(TThread.CurrentThread,
          procedure
            begin
              if assigned(fOnCreateShapesProgress) then
                fOnCreateShapesProgress(nil, 'Reconfiguring ', i / n);
            end);
      end
    );
  end;
end;

我已将 for 循环替换为并行 for 循环。计数器“i”在递增以显示进度时被锁定。然后，我将 OnCreateShapeProgress 事件包装在 TThread.Queue 中，由主线程处理。 OnCreateShapeProgress 事件由更新进度条和描述任务的标签的例程处理。

如果我排除对 OnCreateShapeProgress 事件的调用，该例程将起作用。它会因 EAurgumentOutOfRange 错误而崩溃。

所以我的问题很简单：

我做了什么蠢事吗？

如何从 TParallel.For 循环或 TTask 中调用事件处理程序？

Answer 1

我能看到的最明显的问题是你排队到工作线程。

您对TThread.Queue 的调用通过TThread.CurrentThread。这就是您调用TThread.Queue 的线程。我认为可以肯定地说你永远不应该将TThread.CurrentThread 传递给TThread.Queue。

相反，删除该参数。使用仅接受线程过程的一个参数重载。

否则，我会注意到进度计数器i 的递增并未真正正确处理。好吧，增量很好，但是您稍后再阅读它，那是一场竞赛。如果线程 1 在线程 2 之前递增但线程 2 在线程 1 之前排队进度，则您可以报告无序的进度。通过将计数器递增代码移动到主线程来解决这个问题。只需在排队的匿名方法中增加它。额外的好处是您不再需要使用原子增量，因为所有修改都在主线程上。

除此之外，此 QC 报告似乎与您报告的内容非常相似：http://qc.embarcadero.com/wc/qcmain.aspx?d=128392

最后，AtomicIncrement 是在最新版本的 Delphi 中执行无锁递增的惯用方式。