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

Question

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?

Answer 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 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. If you fix this with ProcessMessages, you really should consider it a temporary solution.

Especially take care that using ProcessMessages means that you must make sure that all of your message handlers are re-entrant.

Answer 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;

Answer 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.

Answer 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.

Answer 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;