1{
2 /***************************************************************************
3                               Splash.pp
4                               ---------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 *                                                                         *
10 *   This source is free software; you can redistribute it and/or modify   *
11 *   it under the terms of the GNU General Public License as published by  *
12 *   the Free Software Foundation; either version 2 of the License, or     *
13 *   (at your option) any later version.                                   *
14 *                                                                         *
15 *   This code is distributed in the hope that it will be useful, but      *
16 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
17 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
18 *   General Public License for more details.                              *
19 *                                                                         *
20 *   A copy of the GNU General Public License is available on the World    *
21 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
22 *   obtain it by writing to the Free Software Foundation,                 *
23 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
24 *                                                                         *
25 ***************************************************************************
26}
27unit Splash;
28
29{$mode objfpc}{$H+}
30
31interface
32
33uses
34  Buttons,
35  Classes,
36  Controls,
37  ExtCtrls,
38  Forms,
39  Graphics,
40  LResources,
41  SysUtils,
42  LazConf;
43
44type
45
46  { TSplashForm }
47
48  TSplashForm = class(TForm)
49    Image: TImage;
50    procedure ApplicationOnIdle(Sender: TObject; var {%H-}Done: boolean);
51    procedure ImagePaint(Sender: TObject);
52  private
53    procedure LoadSplash;
54  public
55    constructor Create(AOwner: TComponent); override;
56    destructor Destroy; override;
57
58    procedure Show;
59  end;
60
61var
62  SplashForm: TSplashForm;
63
64implementation
65
66uses
67  GraphUtil;
68
69{$R *.lfm}
70{$R ../images/splash_logo.res}
71
72const
73  VersionStyle: TTextStyle =
74    (
75      Alignment  : taCenter;
76      Layout     : tlCenter;
77      SingleLine : True;
78      Clipping   : True;
79      ExpandTabs : False;
80      ShowPrefix : False;
81      Wordbreak  : False;
82      Opaque     : False;
83      SystemFont : False;
84      RightToLeft: False;
85      EndEllipsis: False;
86    );
87  VersionFontStyle: TFontStyles = [fsBold];
88  VersionFontColor: TColor = clBlue;
89
90constructor TSplashForm.Create(AOwner: TComponent);
91begin
92  inherited Create(AOwner);
93
94  Application.AddOnIdleHandler(@ApplicationOnIdle);
95end;
96
97destructor TSplashForm.Destroy;
98begin
99  Application.RemoveOnIdleHandler(@ApplicationOnIdle);
100
101  inherited Destroy;
102
103  SplashForm := nil;
104end;
105
106procedure TSplashForm.ApplicationOnIdle(Sender: TObject; var Done: boolean);
107begin
108  Hide;
109end;
110
111procedure TSplashForm.ImagePaint(Sender: TObject);
112var
113  ATextRect: TRect;
114begin
115  // GetLazarusVersionString is too long => use LazarusVersionStr
116  ATextRect := Rect(
117    Image.Left,
118    Image.Height - Image.Canvas.TextHeight('Hg')*5 div 4,
119    Image.Width,
120    Image.Height);
121  Image.Canvas.Font.Style := VersionFontStyle;
122  Image.Canvas.Font.Color := VersionFontColor;
123  Image.Canvas.TextRect(ATextRect, ATextRect.Left, ATextRect.Top, LazarusVersionStr, VersionStyle);
124end;
125
126procedure TSplashForm.LoadSplash;
127begin
128  Image.Picture.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
129end;
130
131procedure TSplashForm.Show;
132begin
133  inherited;
134
135  LoadSplash;
136  ScaleImg(Image.Picture.Bitmap, Width, Height);
137end;
138
139end.
140