使用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 之前对进度进行排队，则您可能会乱序报告进度。通过将计数器递增代码移动到主线程来解决该问题。只需在排队的匿名方法内增加它即可。额外的好处是您不再需要使用原子增量，因为所有修改都在主线程上。

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

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