Show a Form with a message and an animated image while the application is busy

2
votes

I'm trying to show an information message and an animated gif (an Hourglass) while my application is busy (loading a query).

I have defined a Form to show that Message (using the code shown in this post: How to use Animated Gif in a delphi form). This is the constructor.

constructor TfrmMessage.Show(DisplayMessage: string);
begin
  inherited Create(Application);
  lblMessage.Caption := DisplayMessage;
  // Set the Message Window on Top
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
  Visible := True;
  // Animate the HourGlass image
  (imgHourGlass.Picture.Graphic as TGIFImage).Animate := True;
  Update;
end;

The problem is that the animated Gif remains still while the main thread is busy (loading the query).

I have tried drawing manually the animation on a separate thread.

type
  TDrawHourGlass = class(TThread)
    private
      FfrmMessage: TForm;
    public
      constructor Create(AfrmMessage: TForm);
      procedure Execute; override;
      procedure ShowFrame1;
      procedure ShowFrame2;
      procedure ShowFrame3;
      procedure ShowFrame4;
      procedure ShowFrame5;
  end;

constructor TDrawHourGlass.Create(AfrmMessage: TForm);
begin
  inherited Create(False);
  FfrmMessage := AfrmMessage;
end;

procedure TDrawHourGlass.Execute;
var FrameActual: integer;
begin
  FrameActual := 1;
  while not Terminated do begin
    case FrameActual of
      1: Synchronize(ShowFrame1);
      2: Synchronize(ShowFrame2);
      3: Synchronize(ShowFrame3);
      4: Synchronize(ShowFrame4);
      5: Synchronize(ShowFrame5);
    end;
    FrameActual := FrameActual + 1;
    if FrameActual > 6 then FrameActual := 1;
    sleep(200);
  end;
end;

procedure TDrawHourGlass.ShowFrame1;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame1.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

implementation

procedure TDrawHourGlass.ShowFrame2;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame2.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

procedure TDrawHourGlass.ShowFrame3;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame3.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

procedure TDrawHourGlass.ShowFrame4;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame4.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

procedure TDrawHourGlass.ShowFrame5;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame5.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

But I get the same result, while the main thread is busy the animation remains still, because the calls (FfrmMessage as TfrmMessage).imgHourGlass.Update; to draw each frame, waits until the main thread has finished (even when not calling them within a Synchronize).

Do you have a suggestion what can I also try ?.

Thank you.

2
delphidelphi-10.1-berlin
Are you using FireDAC or another library? – Victoria
Yes, FireDAC (calling a Datasnap remote method that returns a Dataset). – Marc Guillot
Well, then it's not a data component that needs to work in the background but a REST call (why would you need to display such dialog on server?). FireDAC has support for asynchronous mode, but for REST server it's unwanted. It has some threading model, as far as I remember. – Victoria
I see. Then create a thread in which you'll be waiting for an execution event, do the REST call and post the received dataset as a parameter of a message posted to an invisible window created by AllocateHwnd, or use Synchronize to pass the dataset to the main thread. The animation keep running in the main thread. Create that form when the thread starts, destroy it when thread is terminated or starts waiting for another execution. – Victoria
No, so long you keep the main thread message loop blocked by a long running synchronous call, any worker thread won't help you (Synchronize will execute after such call finishes). Rule of thumb for a responsible UI is, keep the main thread without any long running blocking calls (which such REST call is, so move that call to a worker thread). – Victoria

2 Answers

4
votes

It's very unfortunate that the many components in Delphi basically encourage poor application design (blocking the main thread). In situations like this, you should seriously consider swapping around the purpose of your thread, so that all lengthy processing is done inside of a thread (or multiple), and leave all the drawing up to the main UI thread. There aren't many clean ways to make the main thread responsive while it's processing any amount of data.

3
votes

If it's only for a query and you're using FireDAC, then check out http://docwiki.embarcadero.com/RADStudio/Berlin/en/Asynchronous_Execution_(FireDAC) it seems to be possible.

To handle any kind of lengthy processing, you can use the Threading unit. You don't do the work in the main thread so the UI can be displayed correctly.

This example is not perfect (you should probably use some kind of callback), but the gif is spinning.

procedure TForm3.ButtonProcessClick(Sender: TObject);
begin
  // Block UI to avoid executing the work twice
  ButtonProcess.Enabled := false;
  TTask.Create(
    procedure
    begin
      Sleep(10000);
      // Enable UI again
      ButtonProcess.Enabled := true;
    end).Start();
end;

To make the gif spin in the first place I use :

procedure TForm3.FormCreate(Sender: TObject);
begin
  (GifLoading.Picture.Graphic as TGIFImage).Animate := true;
end;

I haven't tried, but this link seems to provide something very close from what you want.

Hope this helps.