Delphi:如何防止单线程应用程序丢失响应？

Question

我正在使用 Delphi 开发一个单线程应用程序，它将执行一项耗时的任务，如下所示:

// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
    DoTask();
End;

当循环开始时，应用程序将丢失对最终用户的响应。那不太好。由于其复杂性，我也不想将其转换为多线程应用程序，因此我相应地添加了 Application.ProcessMessages，

// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
Application.ProcessMessages;
End;

不过，这一次应用程序虽然会响应用户操作，但是循环中消耗的时间却比原来的循环多了很多，大约是原来的10倍。

有没有一种解决方案可以确保应用程序不会丢失响应，同时又不会过多增加消耗的时间？

Answer 1

你确实应该使用工作线程。这就是线程的好处。

使用Application.ProcessMessages()只是一个创可贴，而不是解决方案。当 DoTask() 执行其工作时，您的应用仍将没有响应，除非您对 DoTask() 进行额外的调用 Application.ProcessMessages() >。另外，如果不小心的话，直接调用 Application.ProcessMessages() 会导致重入问题。

如果您必须直接调用 Application.ProcessMessages()，那么不要调用它，除非确实有消息等待处理。您可以使用 Win32 API GetQueueStatus() 函数来检测该情况，例如:

// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
  DoTask();
  if GetQueueStatus(QS_ALLINPUT) <> 0 then
    Application.ProcessMessages;
End;

否则，将 DoTask() 循环移动到线程中(是的，是的)，然后让你的 main循环使用 MsgWaitForMultipleObjects() 等待任务线程完成。这仍然允许您检测何时处理消息，例如:

procedure TMyTaskThread.Execute;
begin
  // time-consuming loop
  for I := 0 to 1024 * 65536 do
  begin
    if Terminated then Exit;
    DoTask();
  end;
end;

var
  MyThread: TMyTaskThread;
  Ret: DWORD;
begin
  ...
  MyThread := TMyTaskThread.Create;
  repeat
    Ret := MsgWaitForMultipleObjects(1, Thread.Handle, FALSE, INFINITE, QS_ALLINPUT);
    if (Ret = WAIT_OBJECT_0) or (Ret = WAIT_FAILED) then Break;
    if Ret = (WAIT_OBJECT_0+1) then Application.ProcessMessages;
  until False;
  MyThread.Terminate;
  MyThread.WaitFor;
  MyThread.Free;
  ...
end;