How-to-do-an-auto-splash-screen-with-progression


            Title: How to do an auto-splash screen with progression
Question: 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 cration 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.
Forms Delphi
