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

你说 :

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

我可以认为这意味着两件事之一:

1. 您的应用程序是一堆庞大的遗留代码,如此庞大且编写​​得如此糟糕,以至于封装DoTask在一个线程中意味着需要进行大量的重构,而这些重构无法实现可行的业务案例.
2. 您觉得编写多线程代码太"复杂"而且您不想学习如何执行此操作.

如果案例是#2则没有任何借口 - 多线程是这个问题的明确答案.将方法推入线程并不是那么可怕,你将成为一个更好的开发人员来学习如何去做.

如果病例是#1,我把这个留给你决定,然后在医生给你一个4岁的孩子第一次尝试吗啡时犹豫不决,我会注意到,在这个循环的持续时间你会Application.ProcessMessages用这个来打电话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它究竟是多么复杂,以及将它重构成一个线程是否真的是一项艰巨的任务.使用上面的代码修复此问题将导致每个遵循并运行该代码的开发人员永远诅咒您的名字.这真的是可怕的,可怕的做法,除了最极端的情况外,应该尽可能地避免.被警告.如果你解决这个问题ProcessMessages,你真的应该把它当作一个临时解决方案,并且如果时间压力暂时不允许的话,尽一切努力在更方便的时候重构它.

特别注意使用ProcessMessages手段,你必须确保所有的消息处理程序都是可重入的,否则你将会被你将要努力理解的神秘错误所困扰.

Answer 2

你真的应该使用一个工作线程.这就是线程有用的东西.

使用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()循环移动到一个线程(是的,是的)然后让你的主循环使用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;

Answer 3

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在表单中添加对方法的调用.