Search code examples
multithreadingexceptiondelphitaskloading

Routine to perform actions in Tasks, showing a loading screen, without freezing the main form


I'm looking to build a routine that is responsible for executing any action via procedure (Tproc) using Tasks, while displaying a loading screen, without freezing the system's main form. An extra detail is that it is also capable of capturing a possible exception that the action may have generated.

I built the code below, which works well, but sometimes something goes wrong and the loading screen ends up not closing, remaining always present on the screen.

Any suggestions will be welcome. Thanks.

type
  TLoadingClass= class
  strict private
    class var FForm: TForm;

  public
    class procedure ActionAndWait(Action: Tproc);
  end;

class procedure TLoadingClass.ActionAndWait(Action: Tproc);
var
  aTask: ITask;
  vException: Pointer;
begin
  vException := nil;

  FForm := TLoadingForm.Create(nil);
  try
    aTask := TTask.Run(procedure
      begin
        try
          try
            Action; {Run Action}
          except on E: Exception do
            vException := @E {Capture Exception}
          end
        finally
          while not FForm.Showing do {Wait for the form to be created, if the action is very quick.}
            Sleep(1);
          TLoadingForm(FForm).Hide;
          TLoadingForm(FForm).Close;
        end;
      end);
    TLoadingForm(FForm).ShowModal; {Show the loading form}
  finally
    TTask.WaitForAll(aTask);
    FreeAndNil(FForm);
    if Assigned(vException) then
      raise Exception(@vException);
  end;
end;

Call example

  TLoadingClass.ActionAndWait(
  procedure
  begin
    try
      Sleep(5000);
      raise Exception.Create('Test');
    except on E: Exception do
      ShowMessage(E.Message);
    end;
  end);

Solution

  • Your code has several issues.

    First, you are accessing the UI (form) from the background thread which you should never do. Such code always needs to be synchronized with the main thread.

    Next, you are not handling task exceptions properly. Exception objects are automatically handled by compiler and you cannot just grab a pointer to the exception object and use it later on. The whole try...except within task method is useless. If there is unhandled exception within the task, Wait or WaitForAll will raise EAggregatedException and you can catch that exception and handle its inner exception(s) there. If there are multiple tasks that raised exceptions, there will be multiple inner exceptions.

    Next, you are already catching the exception inside anonymous method passed to ActionAndWait so such captured exception will not be propagated as EAgreggatedException. ShowMessage within ActionAndWait will run in the context of the background thread and if you want to use and UI from there it also needs to be synchronized with the main thread.

    You have FForm declared as field in TLoadingClass. It would be better that you remove that field and use local variable like you are using for the task. Also there is no need to typecast FForm as TLoadingForm when you are calling Hide and Close. Besides that, calling Close is sufficient as it will also hide the form.

    Cleaned and corrected code would look like:

    class procedure TLoadingClass.ActionAndWait(Action: Tproc);
    var
      LTask: ITask;
      LForm: TLoadingForm;
    begin
      try
        LTask := TTask.Create(procedure
          begin
            try
              Action;
            finally
              TThread.Queue(nil,
                procedure
                begin
                  LForm.Close;
                end);
            end;
          end);
        LForm := TLoadingForm.Create(nil);
        try
          try
            LTask.Start;
            LForm.ShowModal;
          finally
            TTask.WaitForAll(LTask);
          end;
        finally
          LForm.Free;
        end;
      except
        on E: EAggregateException do
          for var i := 0 to E.Count - 1 do
            ShowMessage(E.InnerExceptions[i].Message);
        on E: Exception do
          ShowMessage(E.Message);
      end;
    end;
    

    And the call example:

      TLoadingClass.ActionAndWait(
      procedure
      begin
        Sleep(5000);
        raise Exception.Create('Test');
      end);