Author: Olivier Rogier
A convenience forms auto-creation while showing progression on application start.
Answer:
1 {
2 ///////////////////////////////////////////////////////////////////////////////
3 Auto splash form class
4 ///////////////////////////////////////////////////////////////////////////////
5 USE : Replace the Delphi standard form creation (Application.CreateForm) by
6
7 with TfmToolsAutoSplash.Create(nil) do
8 try
9 Add('Data Module', TdmMain, dmMain, 100);
10 Add('Main Form', TfmMain, fmMain, 100);
11 Add('Log', TfmLog, fmLog, 100);
12 Execute;
13 finally
14 Free;
15 end;
16 ///////////////////////////////////////////////////////////////////////////////
17 }
18
19 unit F_TOOLS_AutoSplash;
20
21 // ############################################################################
22
23 interface
24
25 uses
26 Forms, Controls, StdCtrls, Classes, ExtCtrls, ComCtrls;
27
28 const
29 SPLASH_STEP_CAPTION: string = 'Creating : ';
30 SPLASH_INITIALIZATION_CAPTION: string = 'Initialization...';
31 SPLASH_FINALISATION_CAPTION: string = 'Finalization...';
32
33 type
34 TfmToolsAutoSplash = class(TForm)
35 pn1: TPanel;
36 pn2: TPanel;
37 pn3: TPanel;
38 lbTitle: TLabel;
39 lbVersion: TLabel;
40 lbCopyright: TLabel;
41 lbStep: TLabel;
42 prgbStep: TProgressBar;
43 procedure FormCreate(Sender: TObject);
44 procedure FormDestroy(Sender: TObject);
45 private
46 FFormsList: TCollection;
47 protected
48 procedure DoStep(ALabel: string; ADelay: integer); virtual;
49 public
50 procedure Clear;
51 procedure Add(Caption: string; FormClass: TComponentClass; var Ref; Delay:
52 integer
53 = 250);
54 procedure Execute;
55 end;
56
57 // ############################################################################
58
59 implementation
60
61 uses
62 Windows, SysUtils, Dialogs;
63
64 {$R *.DFM}
65
66 type
67 TSplashFormPtr = ^TForm;
68
69 TSplashFormAllocItem = class(TCollectionItem)
70 protected
71 Text: string;
72 InstanceClass: TComponentClass;
73 Reference: TSplashFormPtr;
74 Tempo: integer;
75 end;
76
77 //----------------------------------------------------------------------
78 // TfmToolsAutoSplash.FormCreate
79 //----------------------------------------------------------------------
80
81 procedure TfmToolsAutoSplash.FormCreate(Sender: TObject);
82 begin
83 FFormsList := TCollection.Create(TSplashFormAllocItem);
84 end;
85
86 //----------------------------------------------------------------------
87 // TfmToolsAutoSplash.FormDestroy
88 //----------------------------------------------------------------------
89
90 procedure TfmToolsAutoSplash.FormDestroy(Sender: TObject);
91 begin
92 FFormsList.Free;
93 end;
94
95 //----------------------------------------------------------------------
96 // TfmToolsAutoSplash.Clear
97 //----------------------------------------------------------------------
98
99 procedure TfmToolsAutoSplash.Clear;
100 begin
101 FFormsList.Clear;
102 end;
103
104 //----------------------------------------------------------------------
105 // TfmToolsAutoSplash.Add
106 //----------------------------------------------------------------------
107 // SPEC : Add a form in the list.
108 // IN : Caption -> Title, if '' then use classname
109 // FormClass -> Class
110 // Ref -> Reference
111 // Delay -> Delay
112 //----------------------------------------------------------------------
113
114 procedure TfmToolsAutoSplash.Add(Caption: string; FormClass: TComponentClass; var
115 Ref;
116 Delay: integer);
117 begin
118 with (FFormsList.Add as TSplashFormAllocItem) do
119 begin
120 case (Caption = '') of
121 True: Text := SPLASH_STEP_CAPTION + FormClass.ClassName;
122 False: Text := SPLASH_STEP_CAPTION + Caption;
123 end;
124 InstanceClass := FormClass;
125 Reference := @TForm(Ref);
126 Tempo := Delay;
127 end;
128 end;
129
130 //----------------------------------------------------------------------
131 // TfmToolsAutoSplash.DoStep
132 //----------------------------------------------------------------------
133
134 procedure TfmToolsAutoSplash.DoStep(ALabel: string; ADelay: integer);
135 begin
136 prgbStep.StepIt;
137 lbStep.Caption := ALabel;
138 Refresh;
139 Sleep(ADelay);
140 end;
141
142 //----------------------------------------------------------------------
143 // TfmToolsAutoSplash.Execute
144 //----------------------------------------------------------------------
145 // SPEC : Lance la création des feuilles.
146 //----------------------------------------------------------------------
147
148 procedure TfmToolsAutoSplash.Execute;
149 var
150 i: integer;
151 begin
152 prgbStep.Max := FFormsList.Count + 2;
153 Show;
154 DoStep(SPLASH_INITIALIZATION_CAPTION, 2);
155 for i := 0 to FFormsList.Count - 1 do
156 with (FFormsList.Items[i] as TSplashFormAllocItem) do
157 begin
158 DoStep(Text, Tempo);
159 if (not Application.Terminated) then
160 Application.CreateForm(InstanceClass, Reference^);
161 end;
162 DoStep(SPLASH_FINALISATION_CAPTION, 2);
163 end;
164
165 end.
|
