响应式 GUI 使用线程进行后台工作，PostMessage 使用线程进行报告

在运行冗长的进程时保持 GUI 响应需要一些非常精细的回调来允许 GUI 处理其消息队列，或者使用（后台）（工作）线程。

开始任意数量的线程来完成一些工作通常不是问题。当你想要使 GUI 显示中间和最终结果或报告进度时，开始有趣。

在 GUI 中显示任何内容都需要与控件和/或消息队列/泵进行交互。这应该始终在主线程的上下文中完成。从不在任何其他线程的上下文中。

有很多方法可以解决这个问题。

此示例显示了如何使用简单线程执行此操作，允许 GUI 在完成后通过将 FreeOnTerminate 设置为 false 来访问线程实例，并使用 PostMessage 报告线程何时完成。

有关竞争条件的注释：对工作线程的引用保存在表单中的数组中。线程完成后，数组中的相应引用将被取消。

这是竞争条件的潜在来源。正如使用 Running 布尔值一样，可以更容易地确定是否还有任何需要完成的线程。

你需要决定是否需要使用锁来保护这些资源。

在这个例子中，没有必要。它们仅在两个位置进行修改：StartThreads 方法和 HandleThreadResults 方法。这两种方法只能在主线程的上下文中运行。只要你保持这种方式并且不从不同线程的上下文开始调用这些方法，就没有办法让它们产生竞争条件。

线

type
  TWorker = class(TThread)
  private
    FFactor: Double;
    FResult: Double;
    FReportTo: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(const aFactor: Double; const aReportTo: THandle);

    property Factor: Double read FFactor;
    property Result: Double read FResult;
  end;

构造函数只设置私有成员并将 FreeOnTerminate 设置为 False。这是必不可少的，因为它将允许主线程查询线程实例的结果。

execute 方法执行计算，然后将消息发布到它在构造函数中收到的句柄，说明它已完成：

procedure TWorker.Execute;
const
  Max = 100000000;var
  i : Integer;
begin
  inherited;

  FResult := FFactor;
  for i := 1 to Max do
    FResult := Sqrt(FResult);

  PostMessage(FReportTo, UM_WORKERDONE, Self.Handle, 0);
end;

在这个例子中，使用 PostMessage 是必不可少的。PostMessage``just 将消息放入主线程消息泵的队列中，并且不等待它被处理。它本质上是异步的。如果你要使用 SendMessage，你就会把自己编成泡菜。SendMessage 将消息放入队列并等待，直到它被处理完毕。简而言之，它是同步的。

自定义 UM_WORKERDONE 消息的声明声明为：

const
  UM_WORKERDONE = WM_APP + 1;
type
  TUMWorkerDone = packed record
    Msg: Cardinal;
    ThreadHandle: Integer;
    unused: Integer;
    Result: LRESULT;
  end;

UM_WORKERDONE const 使用 WM_APP 作为其值的起点，以确保它不会干扰 Windows 或 Delphi VCL 使用的任何值（如 MicroSoft 推荐的那样）。

形成

任何形式都可用于启动线程。你需要做的就是添加以下成员：

private
  FRunning: Boolean;
  FThreads: array of record
    Instance: TThread;
    Handle: THandle;
  end;
  procedure StartThreads(const aNumber: Integer);
  procedure HandleThreadResult(var Message: TUMWorkerDone); message UM_WORKERDONE;

哦，示例代码假定在表单的声明中存在 Memo1: TMemo;，它用于记录和报告。

FRunning 可用于防止 GUI 在工作进行时被点击。FThreads 用于保存实例指针和创建的线程的句柄。

启动线程的过程有一个非常简单的实现。它首先检查是否已经有一组线程在等待。如果是这样，它就会退出。如果没有，它将标志设置为 true 并启动线程，为每个线程提供自己的句柄，以便他们知道在哪里发布他们的完成消息。

procedure TForm1.StartThreads(const aNumber: Integer);
var
  i: Integer;
begin
  if FRunning then
    Exit;
    
  FRunning := True;

  Memo1.Lines.Add(Format('Starting %d worker threads', [aNumber]));
  SetLength(FThreads, aNumber);
  for i := 0 to aNumber - 1 do
  begin
    FThreads[i].Instance := TWorker.Create(pi * (i+1), Self.Handle);
    FThreads[i].Handle := FThreads[i].Instance.Handle;
  end;
end;

线程的句柄也放在数组中，因为这是我们在消息中收到的消息，它告诉我们线程已经完成并且在线程的实例外部使它更容易访问。如果我们不需要实例来获取结果（例如，如果它们已存储在数据库中），那么在线程实例外部使用句柄也允许我们使用 FreeOnTerminate 设置为 True。在这种情况下，当然不需要保留对实例的引用。

乐趣在于 HandleThreadResult 实现：

procedure TForm1.HandleThreadResult(var Message: TUMWorkerDone);
var
  i: Integer;
  ThreadIdx: Integer;
  Thread: TWorker;
  Done: Boolean;
begin
  // Find thread in array
  ThreadIdx := -1;
  for i := Low(FThreads) to High(FThreads) do
    if FThreads[i].Handle = Cardinal(Message.ThreadHandle) then
    begin
      ThreadIdx := i;
      Break;
    end;

  // Report results and free the thread, nilling its pointer and handle 
  // so we can detect when all threads are done.
  if ThreadIdx > -1 then
  begin
    Thread := TWorker(FThreads[i].Instance);
    Memo1.Lines.Add(Format('Thread %d returned %f', [ThreadIdx, Thread.Result]));
    FreeAndNil(FThreads[i].Instance);
    FThreads[i].Handle := nil;
  end;

  // See whether all threads have finished.
  Done := True;
  for i := Low(FThreads) to High(FThreads) do
    if Assigned(FThreads[i].Instance) then
    begin
      Done := False;
      Break;
    end;
  if Done then
  begin
    Memo1.Lines.Add('Work done');
    FRunning := False;
  end;
end;

此方法首先使用消息中收到的句柄查找线程。如果找到匹配，它会使用实例检索并报告线程的结果（FreeOnTerminate 是 False，记得吗？），然后结束：释放实例并将实例引用和句柄都设置为 nil，表明此线程为 no 更长的相关。

最后，它检查是否有任何线程仍在运行。如果没有找到，则报告全部完成并将 FRunning 标志设置为 False，以便可以开始新的一批工作。