How to do an auto-splash screen with progression (Views: 31)
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. |