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

我正在用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倍

---

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

应用程序。应避免使用ProcessMessages

。它会给你的程序带来各种各样的奇怪的东西。A必须为：

在您的情况下，线程就是解决方案，即使

DoTask（）

可能需要进行一些重构才能在线程中运行

下面是一个使用的简单示例。（需要Delphi XE或更新版本）

线程是自销毁的，您可以在表单中为方法添加一个

OnTerminate

调用。

您说：

我也不想将其转换为多线程应用程序 因为它的复杂性

我可以将其理解为两件事之一：

您的应用程序是一堆杂乱无章的遗留代码，这些代码非常庞大，而且编写得非常糟糕，因此将

DoTask

封装在一个线程中将意味着大量的重构，而这些重构无法生成可行的业务案例

您觉得编写多线程代码太“复杂”，不想学习如何编写

如果情况是#2，那么就没有任何借口——多线程是这个问题的明确答案。将方法滚动到线程中并不可怕，您将成为一名更好的开发人员，学习如何执行它

如果情况是#1，我把这件事留给你来决定，那么尽管医生第一次给一个四岁的孩子注射吗啡时犹豫不决，我会注意到，在循环过程中，你将调用

应用程序。处理消息

6700万次：

For I := 0 to 1024 * 65536 do
Begin
  DoTask();
  Application.ProcessMessages;
End;

掩盖这一罪行的典型方式就是每次运行循环时不调用

Application.ProcessMessages

For I := 0 to 1024 * 65536 do
Begin
  DoTask();
  if I mod 1024 = 0 then Application.ProcessMessages;
End;

但是，如果执行

Application.ProcessMessages

所需的时间实际上是

DoTask（）

的十倍，那么我真的很怀疑

DoTask

到底有多复杂，以及重构成线程是否真的很难。用上面的代码修复这个问题会导致每一个遵循和运行该代码的开发人员永远诅咒你的名字。这确实是一种可怕的做法，在除最极端的情况外的所有情况下都应适当避免。被警告。如果用“代码>进程消息< /COD>”来修复这个问题，你确实应该认为这是一个临时解决方案，如果时间压力不允许的话，就要在一个更方便的时间重新调整它。

---

特别要注意的是，使用

ProcessMessages

意味着您必须确保所有的消息处理程序都是可重入的，否则您将被神秘的bug所困扰，您将努力去理解这些bug

每次迭代调用

Application.ProcessMessages

确实会降低性能，如果无法预测每次迭代需要多长时间，那么每隔几次调用它并不总是能很好地工作，因此我通常会使用

GetTickCount

来计算100毫秒过后的时间（1）。这足够长，不会使性能降低太多，并且足够快，可以使应用程序看起来响应迅速

var
  tc:cardinal;
begin
  tc:=GetTickCount;
  while something do
   begin
    if cardinal(GetTickCount-tc)>=100 then
     begin
      Application.ProcessMessages;
      tc:=GetTickCount;
     end;
    DoSomething;
   end;
end;

---

（1） ：不完全是100毫秒，但距离很近。有更精确的方法来测量时间，如QueryPerformanceTimer，但这同样需要更多的工作，可能会影响性能。

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

使用<代码> Apdio.PultMasaSeres（）<代码>是一个创可贴，而不是解决方案。当

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;

---

@user2704265，当您提到“应用程序将丢失对最终用户的响应”时，您的意思是希望用户继续在应用程序中工作，并不断单击和键入？在这种情况下，请注意前面的答案并使用线程

如果您的应用程序正忙于一项冗长的操作[并且尚未冻结]，那么您可以考虑以下几种选择：

• 不稳定用户输入
• 将光标更改为“忙”
• 使用进度条
• 添加一个取消按钮

根据您对单线程解决方案的要求，我建议您首先禁用用户输入并将光标更改为“忙碌”

procedure TForm1.ButtonDoLengthyTaskClick(Sender: TObject);
var i, j : integer;
begin
  Screen.Cursor := crHourGlass;
  //Disable user input capabilities
  ButtonDoLengthyTask.Enabled := false;

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

      // Calling Processmessages marginally increases the process time
      // If we don't call and user clicks the disabled button while waiting then
      // at the end of ButtonDoLengthyTaskClick the proc will be called again
      // doubling the execution time.

      Application.ProcessMessages;

    End;
  Finally
    Screen.Cursor := crDefault;
    ButtonDoLengthyTask.Enabled := true;
  End;
End;

---

每当我看到有人使用

应用程序时，我总是有点哭。处理消息
并想知道为什么事情不能正常工作。把它放到一个线程中。放弃
ProcessMessages
。同意-它需要一个线程。当然，我可以理解重构复杂遗留应用程序的痛苦。上次我这么做时，这是将以前的过程算法并行化的唯一方法。这意味着从几十个单元中提取数百个全局变量，重构跨越近万行代码的一百多个方法。。。一行一行。
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;

procedure TForm1.ButtonDoLengthyTaskClick(Sender: TObject);
var i, j : integer;
begin
  Screen.Cursor := crHourGlass;
  //Disable user input capabilities
  ButtonDoLengthyTask.Enabled := false;

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

      // Calling Processmessages marginally increases the process time
      // If we don't call and user clicks the disabled button while waiting then
      // at the end of ButtonDoLengthyTaskClick the proc will be called again
      // doubling the execution time.

      Application.ProcessMessages;

    End;
  Finally
    Screen.Cursor := crDefault;
    ButtonDoLengthyTask.Enabled := true;
  End;
End;