How to do an auto-splash screen with progression

Problem/Question/Abstract:

A convenience forms auto-creation while showing progression on application start.

Answer:

{
///////////////////////////////////////////////////////////////////////////////
                            Auto splash form class
///////////////////////////////////////////////////////////////////////////////
USE : Replace the Delphi standard form creation (Application.CreateForm) by

      with TfmToolsAutoSplash.Create(nil) do
        try
          Add('Data Module', TdmMain, dmMain, 100);
          Add('Main Form',   TfmMain, fmMain, 100);
          Add('Log',         TfmLog,  fmLog,  100);
          Execute;
        finally
          Free;
        end;
///////////////////////////////////////////////////////////////////////////////
}

unit F_TOOLS_AutoSplash;

// ############################################################################

interface

uses
  Forms, Controls, StdCtrls, Classes, ExtCtrls, ComCtrls;

const
  SPLASH_STEP_CAPTION: string = 'Creating : ';
  SPLASH_INITIALIZATION_CAPTION: string = 'Initialization...';
  SPLASH_FINALISATION_CAPTION: string = 'Finalization...';

type
  TfmToolsAutoSplash = class(TForm)
    pn1: TPanel;
    pn2: TPanel;
    pn3: TPanel;
    lbTitle: TLabel;
    lbVersion: TLabel;
    lbCopyright: TLabel;
    lbStep: TLabel;
    prgbStep: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FFormsList: TCollection;
  protected
    procedure DoStep(ALabel: string; ADelay: integer); virtual;
  public
    procedure Clear;
    procedure Add(Caption: string; FormClass: TComponentClass; var Ref; Delay: integer
      = 250);
    procedure Execute;
  end;

  // ############################################################################

implementation

uses
  Windows, SysUtils, Dialogs;

{$R *.DFM}

type
  TSplashFormPtr = ^TForm;

  TSplashFormAllocItem = class(TCollectionItem)
  protected
    Text: string;
    InstanceClass: TComponentClass;
    Reference: TSplashFormPtr;
    Tempo: integer;
  end;

  //----------------------------------------------------------------------
  // TfmToolsAutoSplash.FormCreate
  //----------------------------------------------------------------------

procedure TfmToolsAutoSplash.FormCreate(Sender: TObject);
begin
  FFormsList := TCollection.Create(TSplashFormAllocItem);
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.FormDestroy
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.FormDestroy(Sender: TObject);
begin
  FFormsList.Free;
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.Clear
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.Clear;
begin
  FFormsList.Clear;
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.Add
//----------------------------------------------------------------------
// SPEC : Add a form in the list.
// IN   : Caption     -> Title, if '' then use classname
//        FormClass   -> Class
//        Ref         -> Reference
//        Delay -> Delay
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.Add(Caption: string; FormClass: TComponentClass; var Ref;
  Delay: integer);
begin
  with (FFormsList.Add as TSplashFormAllocItem) do
  begin
    case (Caption = '') of
      True: Text := SPLASH_STEP_CAPTION + FormClass.ClassName;
      False: Text := SPLASH_STEP_CAPTION + Caption;
    end;
    InstanceClass := FormClass;
    Reference := @TForm(Ref);
    Tempo := Delay;
  end;
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.DoStep
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.DoStep(ALabel: string; ADelay: integer);
begin
  prgbStep.StepIt;
  lbStep.Caption := ALabel;
  Refresh;
  Sleep(ADelay);
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.Execute
//----------------------------------------------------------------------
// SPEC : Lance la cr�ation des feuilles.
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.Execute;
var
  i: integer;
begin
  prgbStep.Max := FFormsList.Count + 2;
  Show;
  DoStep(SPLASH_INITIALIZATION_CAPTION, 2);
  for i := 0 to FFormsList.Count - 1 do
    with (FFormsList.Items[i] as TSplashFormAllocItem) do
    begin
      DoStep(Text, Tempo);
      if (not Application.Terminated) then
        Application.CreateForm(InstanceClass, Reference^);
    end;
  DoStep(SPLASH_FINALISATION_CAPTION, 2);
end;

end.