Author: Tomas Rutkauskas
How to display different splash screens anytime during program execution
Answer:
Solve 1:
I wanted to be able to display a splash screen anytime during the program run with
different durations and different images each time. The problem with using the
Release method from within a form is that it doesn't set the variable referencing
the splash form to NIL. When the splash form is released, I need to reset the
reference so that I can test it when displaying the form to make sure it's NIL
(that there isn't one already up). I could easily have made the reference public
and set it to NIL after calling Release from within the timer event, but that's not
very reusable.
What I ended up doing is creating a class (TFormWithSplash) derived from TForm that
has all mechanisms necessary to handle the splash screen itself. Then, any form I
want to be able to display splashscreens, I simply derive from this class instead
of TForm. The unit that defines TFormWithSplash has a simple form within it that
contains an image and timer control. The ShowSplash method of TFormWithSplash
creates an instance of this form and displays it. This form then loads the image
file and starts the timer. When the timer elapses, the form closes itself and sends
a user defined message its parent form which frees the reference and resets it to
nil. Everything but the PicFileName, SplashDuration, StayOnTop properties and the
ShowSplash function calls are invisible to the programmer. Here is the code; it
still needs a few features, but seems to work well.
1 unit SplashFrm;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls;
8
9 const
10 WM_SPLASHCLOSED = WM_USER + 113;
11
12 type
13 TFormWithSplash = class;
14 TSplashForm = class(TForm)
15 Image1: TImage;
16 Timer1: TTimer;
17 procedure FormShow(Sender: TObject);
18 procedure FormClose(Sender: TObject; var Action: TCloseAction);
19 procedure Timer1Timer(Sender: TObject);
20 procedure FormDeactivate(Sender: TObject);
21 private
22 CloseOnDeactivate: Boolean;
23 procedure LoadAndDisplay(PicFile: string);
24 public
25 constructor Create(Owner: TFormWithSplash; DisplayFor: Cardinal;
26 CloseOnLostFocus: Boolean; TopMost: Boolean);
27 end;
28
29 TFormWithSplash = class(TForm)
30 PicFile: string;
31 SplashForm: TSplashForm;
32 procedure SetPicFile(FileName: string);
33 procedure OnSplashClosed(var msg: TMessage); message WM_SPLASHCLOSED;
34 public
35 SplashDuration: Cardinal;
36 StayOnTop, CloseOnLostFocus: Boolean;
37 constructor Create(Owner: TComponent); override;
38 procedure ShowSplash;
39 property SplashPicFile: string read PicFile write SetPicFile;
40 end;
41
42 implementation
43
44 {$R *.DFM}
45
46 constructor TFormWithSplash.Create(Owner: TComponent);
47 begin
48 SplashForm := nil;
49 PicFile := '';
50 StayOnTop := True;
51 CloseOnLostFocus := False;
52 inherited Create(Owner);
53 end;
54
55 procedure TFormWithSplash.OnSplashClosed(var msg: TMessage);
56 begin
57 SplashForm.Free;
58 SplashForm := nil;
59 end;
60
61 procedure TFormWithSplash.SetPicFile(FileName: string);
62 begin
63 if not FileExists(FileName) then
64 raise EInOutError.Create('Couldn''t load image file: ' + FileName)
65 else
66 PicFile := FileName;
67 end;
68
69 procedure TFormWithSplash.ShowSplash;
70 begin
71 if PicFile = '' then
72 Exit;
73 while Assigned(SplashForm) do
74 Application.ProcessMessages;
75 SplashForm := TSplashForm.Create(self, SplashDuration, CloseOnLostFocus,
76 StayOnTop);
77 SplashForm.LoadAndDisplay(PicFile);
78 end;
79
80 constructor TSplashForm.Create(Owner: TFormWithSplash; DisplayFor: Cardinal;
81 CloseOnLostFocus: Boolean; TopMost: Boolean);
82 begin
83 inherited Create(Owner);
84 CloseOnDeactivate := CloseOnLostFocus;
85 if TopMost then
86 FormStyle := fsStayOnTop;
87 Image1.AutoSize := True;
88 Timer1.Interval := DisplayFor * 1000;
89 end;
90
91 procedure TSplashForm.LoadAndDisplay(PicFile: string);
92 begin
93 Image1.Picture.LoadFromFile(PicFile);
94 ClientHeight := Image1.Picture.Height + 1;
95 ClientWidth := Image1.Picture.Width + 1;
96 Left := Screen.Width div 2 - Width div 2;
97 Top := Screen.Height div 2 - Height div 2;
98 Show;
99 end;
100
101 procedure TSplashForm.FormShow(Sender: TObject);
102 begin
103 Application.RestoreTopmosts;
104 Timer1.Enabled := True;
105 end;
106
107 procedure TSplashForm.FormClose(Sender: TObject; var Action: TCloseAction);
108 begin
109 PostMessage(TFormWithSplash(Owner).Handle, WM_SPLASHCLOSED, 0, 0);
110 end;
111
112 procedure TSplashForm.Timer1Timer(Sender: TObject);
113 begin
114 Close;
115 end;
116
117 procedure TSplashForm.FormDeactivate(Sender: TObject);
118 begin
119 if CloseOnDeactivate then
120 begin
121 Timer1.Enabled := False;
122 Close;
123 end;
124 end;
125
126 end.
Solve 2:
This information is found in the View Menu and then view Project Source.
127
128 begin
129 SplashScreen := TSplashScreen.Create(Application); //These 3 lines
130 SplashScreen.Show; //Added Manually
131 SplashScreen.Update; //to load SplashScreen
132 Application.Initialize;
133 Application.Title := 'Application Title';
134 Application.CreateForm(TForm1, Form1);
135 SplashScreen.Hide; //These 2 added
136 SplashScreen.Free; //manually to close Splash
137 Application.Run;
138 end.
In Project Options, set SplashScreen Form to be an available form, not Autocreate.
|
