Loading form as overlay while function runs in background

Question

When i call a function and it "runs" (Can be take up to 3 seconds - refresh function getting data from api server) I would like to show a loadingform as an Ajax Loading Indicator as an overlay above the main form.

My previous attempts have all failed. I had tried to change the Create the LoadingForm that it is directly shown after the Main created. Then I tried LoadingForm.Show/Showmodal. In the modal sequence stops and only continues when I close the form and show the window does not close despite .

I also had the situation that the form was opened but the gif wasnt showing, the place where it should be was just white and stayed white - no image no animation

Any idear?

Answer 1

The code below uses a thread to mimic a long time running block in its Execute method and the OnProgress "callback" to notify the form the percent done has changed.

It's a very minimal example but it can show you one of the right directions in my opinion.
Notice that no error checking nor exception handling are currently performed.

---

Unit1.pas the main form and the thread class

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Unit2;

type
  TMyRun = class(TThread)
    protected
      procedure Execute; override;
    public
      OnProgress: TProgressEvent;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FProgressForm: TfrmProgress;
    procedure myRunProgress(Sender: TObject; Stage: TProgressStage;
        PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
    procedure myRunTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TMyRun.Execute;
var
  i: Integer;
  r: TRect;
begin
  for i := 1 to 100 do begin
    if Terminated then
      Break;

    Sleep(50);//simulates some kind of operation

    if Assigned(OnProgress) then
      Synchronize(procedure
          begin
            OnProgress(Self, psRunning, i, False, r, '');
          end);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FProgressForm := TfrmProgress.Create(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FProgressForm.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TMyRun.Create do begin
    FreeOnTerminate := True;
    OnProgress := myRunProgress;
    OnTerminate := myRunTerminate;
  end;
  FProgressForm.ShowModal;
end;

procedure TForm1.myRunProgress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  FProgressForm.ProgressBar1.Position := PercentDone;
end;

procedure TForm1.myRunTerminate(Sender: TObject);
begin
  FProgressForm.Close;
end;

end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 81
  ClientWidth = 181
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 48
    Top = 24
    Width = 91
    Height = 25
    Caption = 'Run the thread'
    TabOrder = 0
    OnClick = Button1Click
  end
end

Unit2.pas the progress dialog

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls;

type
  TfrmProgress = class(TForm)
    ProgressBar1: TProgressBar;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmProgress: TfrmProgress;

implementation

{$R *.dfm}

end.

Unit2.dfm

object frmProgress: TfrmProgress
  Left = 0
  Top = 0
  BorderStyle = bsSizeToolWin
  Caption = 'frmProgress'
  ClientHeight = 51
  ClientWidth = 294
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ProgressBar1: TProgressBar
    Left = 16
    Top = 16
    Width = 265
    Height = 17
    TabOrder = 0
  end
end

---

Referring to the comment which states that the long time running operations need to access a grid in the main form, in order to avoid to block the VCL thread on that object:

1. To avoid the access to the VCL data from the thread - it's the preferred way if the already modified data have to be reused in the routine:
   • pass a copy of the grid's data to the thread - say in the constructor
   • update the copy
   • update the grid with the edited copy of the data after the thread has finished - i.e. after the ShowModal returns.
2. To access the form's object from the thread - this can be done if the form's objects are accessed for very short time intervals:
   • use a synchronized block to get the data from the grid
   • update the grid in a thread's syncronized callback - i.e. in the myRunProgress or in the myRunTerminate method

For different use cases a mixed approach could also make sense (pass the copy in the constructor/update the grid in a thread's syncronized block) if your routine doesn't take in account the already changed data: choose the method which best suits your needs.

If another external thread updates the grid, a thread1 could read the data then fill a form's private queue - say a TThreadList or another collection in a TCriticalSection block - and notify a thread2 to perform a job on the queue but I hope this is probably not needed to have your job done.

Answer 2

Create the dialog form setting:

BorderIcons = []
BorderStyle = bsDialog
FormStyle = fsStayOnTop
Position = poScreenCenter

in the main form when you call your function write:

procedure TFormMain.Button1Click(Sender: TObject);
begin
    Enabled:=false;
    try
        FormDialog.Show;
        FormDialog.Refresh;

        MyLongRunProcedure; // calls your procedure here

    finally        
        Enabled:=true;
        FormDialog.Close;
    end;
end;

It should work..