Delphi: How to prevent a single thread app from losing responses?

问题:

I am developing a single thread app with Delphi, which will do a time-consuming task, like this:

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

When the loop starts, the application will lose responses to the end user. That is not very good. I also do not want to convert it into a multi-thread application because of its complexity, so I add Application.ProcessMessages accordingly,

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

However, this time although the application will response to user operations, the time-consumed in the loop is much more than the original loop, about 10 times.

Is there a solution to make sure the application does not lose the response while do not increase the consumed time too much?

回答1:

You say :

I also do not want to convert it into a multi-thread application because of its complexity

I can take this to mean one of two things :

1. Your application is a sprawling mess of legacy code that is so huge and so badly written that encapsulating DoTask in a thread would mean an enormous amount of refactoring for which a viable business case cannot be made.
2. You feel that writing multithreaded code is too "complex" and you don't want to learn how to do it.

If the case is #2 then there is no excuse whatsoever - multithreading is the clear answer to this problem. It's not so scary to roll a method into a thread and you'll become a better developer for learning how to do it.

If the case is #1, and I leave this to you to decide, then with all the hesitation of a doctor giving a four-year-old his first taste of morphine, I'll note that for the duration of the loop you will be calling Application.ProcessMessages 67 million times with this :

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

The typical way that this crime is covered up is simply by not calling Application.ProcessMessages every time you run through the loop.

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

But if Application.ProcessMessages is actually taking ten times longer than DoTask() to execute then I really question how complex DoTask really is and whether it really is such a hard job to refactor it into a thread. Fixing this with the above code will cause every developer who follows and runs into that code to curse your name forever. It really is terrible, terrible practice and should be duly avoided in all but the most extreme circumstances. Be warned. If you fix this with ProcessMessages, you really should consider it a temporary solution and make all efforts to refactor this at a more convenient time if time pressure does not allow it at the moment.

Especially take care that using ProcessMessages means that you MUST make sure that all of your message handlers are re-entrant or you will be plagued with mysterious bugs that you will fight to understand.

回答2:

You really should use a worker thread. This is what threads are good for.

Using Application.ProcessMessages() is a band-aid, not a solution. Your app will still be unresponsive while DoTask() is doing its work, unless you litter DoTask() with additional calls to Application.ProcessMessages(). Plus, calling Application.ProcessMessages() directly introduces reentrant issues if you are not careful.

If you must call Application.ProcessMessages() directly, then don't call it unless there are messages actually waiting to be processed. You can use the Win32 API GetQueueStatus() function to detect that condition, for example:

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

Otherwise, move the DoTask() loop into a thread (yeah yeah) and then have your main loop use MsgWaitForMultipleObjects() to wait for the task thread to finish. That still allows you to detect when to process messages, eg:

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; 

回答3:

Application.ProcessMessages should be avoided. It can cause all sorts of strange things to your program. A must read: The Dark Side of Application.ProcessMessages in Delphi Applications.

In your case a thread is the solution, even though DoTask() may have to be refactored a bit to run in a thread.

Here is a simple example using an anonymous thread. (Requires Delphi-XE or newer).

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; 

The thread is self destroyed, and you can add a OnTerminate call to a method in your form.

回答4:

Calling Application.ProcessMessages at every iteration will indeed slow down performance, and calling it every few times doesn't always work well if you can't predict how long each iteration will take, so I typically will use GetTickCount to time when 100 milliseconds have passed (1). This is long enough to not slow down performance too much, and fast enough to make the application appear responsive.

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): not exactly 100 milliseconds, but somewhere close. There are more precise ways to measure time like QueryPerformanceTimer, but again this is more work and may hinder performance.

回答5:

@user2704265, when you mention “application will lose responses to the end user”, do you mean that you want your user to continue working around in your application clicking and typing away? In that case - heed the previous answers and use threading.

If it’s good enough to provide feedback that your application is busy with a lengthy operation [and hasn't frozen] there are some options you can consider:

• Dissable user input
• Change the cursor to “busy”
• Use a progressbar
• Add a cancel button

Abiding to your request for a single threaded solution I recommend you start by disabling user input and change the cursor to “busy”.

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; 

文章来源: Delphi: How to prevent a single thread app from losing responses?