How to make GIF animate on "please, wait form"?

Question

I would like make a quick non-closable modal dialog, that pops up while do some tasks and goes away when tasks finish.

There are some inherent difficulties:

• Don't block the main UI thread;
• Don't leave system ghosts windows;
• Move tasks to running into a separate thread;
• Allow update the waiting message to the user;
• Handling exceptions from thread to the application;
• Show animated GIF in the dialog;

How to get around these pitfalls?

Below, a practical example of how I would use it:

TWaiting.Start('Waiting, loading something...');
try
  Sleep(2000);
  TWaiting.Update('Making something slow...');
  Sleep(2000);
  TWaiting.Update('Making something different...');
  Sleep(2000);
finally
  TWaiting.Finish;
end;

Answer 1

type
  TWaiting = class(TForm)
    WaitAnimation: TImage;
    WaitMessage: TLabel;
    WaitTitle: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  strict private
    class var FException: Exception;
  private
    class var WaitForm : TWaiting;
    class procedure OnTerminateTask(Sender: TObject);
    class procedure HandleException;
    class procedure DoHandleException;
  public
    class procedure Start(const ATitle: String; const ATask: TProc);
    class procedure Status(AMessage : String);
  end;

implementation

{$R *.dfm}

procedure TWaiting.FormCreate(Sender: TObject);
begin
  TGIFImage(WaitAnimation.Picture.Graphic).Animate := True;
end;

procedure TWaiting.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

class procedure TWaiting.Start(const ATitle: String; const ATask: TProc);
var
  T : TThread;
begin
  if (not Assigned(WaitForm))then
    WaitForm := TWaiting.Create(nil);

  T := TThread.CreateAnonymousThread(
  procedure
  begin
    try
      ATask;
    except
      HandleException;
    end;
  end);

  T.OnTerminate := OnTerminateTask;
  T.Start;

  WaitForm.WaitTitle.Caption := ATitle;
  WaitForm.ShowModal;

  DoHandleException;
end;

class procedure TWaiting.Status(AMessage: String);
begin
  TThread.Synchronize(TThread.CurrentThread,
  procedure
  begin
    if (Assigned(WaitForm)) then
    begin
      WaitForm.WaitMessage.Caption := AMessage;
      WaitForm.Update;
    end;
  end);
end;

class procedure TWaiting.OnTerminateTask(Sender: TObject);
begin
  if (Assigned(WaitForm)) then
  begin
    WaitForm.Close;
    WaitForm := nil;
  end;
end;

class procedure TWaiting.HandleException;
begin
  FException := Exception(AcquireExceptionObject);
end;

class procedure TWaiting.DoHandleException;
begin
  if (Assigned(FException)) then
  begin
    try
      if (FException is Exception) then
        raise FException at ReturnAddress;
    finally
      FException := nil;
      ReleaseExceptionObject;
    end;
  end;
end;
end.

Usage:

procedure TFSales.FinalizeSale;
begin
  TWaiting.Start('Processing Sale...',
  procedure
  begin
    TWaiting.Status('Sending data to database'); 
    Sleep(2000);
    TWaiting.Status('Updating Inventory');
    Sleep(2000);
  end);
end;