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
116
117
118
119
120
121
122
123
124
|
unit frm_splashscreen;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fpg_base, fpg_main, fpg_edit,
fpg_widget, fpg_form, fpg_label, fpg_button,
fpg_listbox, fpg_memo, fpg_combobox, fpg_grid,
fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar,
fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu,
fpg_panel, fpg_popupcalendar, fpg_gauge;
type
{ TSplashForm }
TSplashForm = class(TfpgForm)
procedure SplashFormShow(Sender: TObject);
procedure TimerFired(Sender: TObject);
private
tmr: TfpgTimer;
protected
procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
procedure AdjustWindowStyle; override;
public
{@VFD_HEAD_BEGIN: SplashForm}
pnlName1: TfpgBevel;
lblName2: TfpgLabel;
lblName1: TfpgLabel;
{@VFD_HEAD_END: SplashForm}
constructor Create(AOwner: TComponent); override;
procedure AfterCreate; override;
end;
{@VFD_NEWFORM_DECL}
var
frmSplash: TSplashForm;
implementation
{@VFD_NEWFORM_IMPL}
procedure TSplashForm.SplashFormShow(Sender: TObject);
begin
tmr.Enabled := True;
end;
procedure TSplashForm.TimerFired(Sender: TObject);
begin
tmr.Enabled := False;
tmr.Free;
// writeln('Timer fired');
Hide;
end;
procedure TSplashForm.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
begin
inherited HandleLMouseUp(x, y, shiftstate);
TimerFired(nil);
end;
procedure TSplashForm.AdjustWindowStyle;
begin
inherited AdjustWindowStyle;
end;
constructor TSplashForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
WindowType := wtPopup; // removes borders and title bar
WindowAttributes := WindowAttributes + [waStayOnTop]; // well, it lets the window stay on top. :)
tmr := TfpgTimer.Create(3000);
tmr.OnTimer := @TimerFired;
OnShow := @SplashFormShow;
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.
|
