4

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

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

4

5 回答 5

11

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

使用Application.ProcessMessages()是创可贴，而不是解决方案。您的应用程序在工作时仍将无响应DoTask()，除非您乱扔垃圾DoTask()对Application.ProcessMessages(). Application.ProcessMessages()另外，如果您不小心，直接调用会引入可重入问题。

如果您必须Application.ProcessMessages()直接调用，那么除非有消息实际等待处理，否则不要调用它。您可以使用 Win32 APIGetQueueStatus()函数来检测这种情况，例如：

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

否则，将DoTask()循环移动到一个线程中（是的，是的），然后让你的主循环用于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;
于 2013-09-18T20:06:58.013 回答
11

你说 ：

由于其复杂性，我也不想将其转换为多线程应用程序

我可以把它理解为两件事之一：

  1. 您的应用程序是一堆杂乱无章的遗留代码，它们如此庞大且编写​​得如此糟糕，以至于封装DoTask在一个线程中意味着大量的重构，而无法为其制定可行的业务案例。
  2. 你觉得写多线程代码太“复杂”，不想学怎么做。

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

如果情况是#1，我让你来决定，那么我会注意到在循环期间你将调用Application.ProcessMessages6700 万次：

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()DoTaskProcessMessages

特别注意使用ProcessMessages意味着您必须确保所有消息处理程序都是可重入的。

于 2013-09-18T18:50:08.600 回答
10

Application.ProcessMessages应该避免。它可能会给您的程序带来各种奇怪的事情。必读：The Dark Side of Application.ProcessMessages in Delphi Applications。

在您的情况下，线程是解决方案，即使DoTask()可能需要稍微重构才能在线程中运行。

这是一个使用anonymous thread. （需要 Delphi-XE 或更新版本）。

uses
  System.Classes;

procedure TForm1.MyButtonClick( Sender : TObject);
var
  aThread : TThread;
begin
  aThread :=
    TThread.CreateAnonymousThread(
      procedure
      var
        I: Integer;
      begin
        // time-consuming loop
        For I := 0 to 1024 * 65536 do
        Begin
          if TThread.CurrentThread.CheckTerminated then
            Break;
          DoTask();
        End;
      end
    );
  // Define a terminate thread event call
  aThread.OnTerminate := Self.TaskTerminated;
  aThread.Start;
  // Thread is self freed on terminate by default
end;

procedure TForm1.TaskTerminated(Sender : TObject);
begin
  // Thread is ready, inform the user
end;

线程是自毁的，您可以OnTerminate在表单中添加对方法的调用。

于 2013-09-18T18:48:40.307 回答
0

在每次迭代时调用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，但这同样需要更多的工作，并且可能会影响性能。

于 2013-09-18T20:01:11.430 回答
0

@user2704265，当您提到“应用程序将失去对最终用户的响应”时，您的意思是您希望您的用户继续在您的应用程序中点击和输入吗？在这种情况下 - 注意前面的答案并使用线程。

如果它足以提供您的应用程序正忙于冗长的操作[并且没有冻结]的反馈，那么您可以考虑一些选项：

  • 禁用用户输入
  • 将光标更改为“忙碌”</li>
  • 使用进度条
  • 添加取消按钮

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

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;
于 2013-09-19T11:38:59.533 回答