delphivcljvcl

Loading form as overlay while function runs in background


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

enter image description here

Any idear?


Solution

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