1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
unit frm_splashscreen;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_panel,
fpg_label;
type
TSplashForm = class(TfpgForm)
private
{@VFD_HEAD_BEGIN: SplashForm}
pnlName1: TfpgBevel;
lblName2: TfpgLabel;
lblName1: TfpgLabel;
{@VFD_HEAD_END: SplashForm}
tmr: TfpgTimer;
procedure SplashFormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure SplashFormShow(Sender: TObject);
procedure TimerFired(Sender: TObject);
procedure SplashFormClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
procedure AfterCreate; override;
end;
{@VFD_NEWFORM_DECL}
var
frmSplash: TSplashForm;
implementation
{@VFD_NEWFORM_IMPL}
procedure TSplashForm.SplashFormClick(Sender: TObject);
begin
TimerFired(nil);
end;
procedure TSplashForm.SplashFormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction := caFree;
end;
procedure TSplashForm.SplashFormShow(Sender: TObject);
begin
tmr.Enabled := True;
end;
procedure TSplashForm.TimerFired(Sender: TObject);
begin
tmr.Enabled := False;
tmr.Free;
Close;
end;
constructor TSplashForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
WindowType := wtPopup; // borderless but doesn't steal focus
WindowAttributes := WindowAttributes + [waStayOnTop]; // well, it lets the window stay on top. :)
tmr := TfpgTimer.Create(3000);
tmr.OnTimer := @TimerFired;
OnShow := @SplashFormShow;
OnClick := @SplashFormClick;
OnClose := @SplashFormClose;
end;
procedure TSplashForm.AfterCreate;
begin
{@VFD_BODY_BEGIN: SplashForm}
Name := 'SplashForm';
SetPosition(298, 261, 300, 64);
WindowTitle := 'SplashForm';
WindowPosition := wpScreenCenter;
Sizeable := False;
pnlName1 := TfpgBevel.Create(self);
with pnlName1 do
begin
Name := 'pnlName1';
SetPosition(0, 0, 300, 64);
OnClick := @TimerFired;
end;
lblName2 := TfpgLabel.Create(pnlName1);
with lblName2 do
begin
Name := 'lblName2';
SetPosition(24, 8, 272, 31);
Text := 'Splash screen goes here!';
FontDesc := 'Arial-18';
OnClick := @TimerFired;
end;
lblName1 := TfpgLabel.Create(pnlName1);
with lblName1 do
begin
Name := 'lblName1';
SetPosition(52, 42, 188, 15);
Text := 'Click me to make me disappear.';
FontDesc := '#Label1';
OnClick := @TimerFired;
end;
{@VFD_BODY_END: SplashForm}
end;
end.
|
