Mega Code Archive
How to do an auto splash screen with progression
<![CDATA[
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.
]]>