/ide/splash.pp

http://github.com/graemeg/lazarus · Puppet · 121 lines · 100 code · 21 blank · 0 comment · 1 complexity · f5cd080cd4f55d22fee7df01e688a355 MD5 · raw file

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