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