1319 lines
46 KiB
ObjectPascal
1319 lines
46 KiB
ObjectPascal
unit usplashabout;
|
|
|
|
{$mode objfpc}{$H+}
|
|
interface
|
|
|
|
{
|
|
Credits
|
|
=======
|
|
uversion.pas by Mike Thompson - mike.cornflake@gmail.com
|
|
originally as VersionSupport.pas
|
|
See uversion.pas header for more details
|
|
All other code by Gordon Bamber - minesadorada@charcodelvalle.com
|
|
|
|
========================================================
|
|
SplashAbout component by minesadorada@charcodelvalle.com
|
|
========================================================
|
|
Licence: LGPL licence. Free to use and/or abuse in your code.
|
|
|
|
Purpose
|
|
=======
|
|
Constructs a Splash screen and/or About form with as little effort and resources as possible :)
|
|
The windows and controls are created and destroyed on-the-fly to reduce application size
|
|
Choice to only use externally-deployed graphics to reduce executable size
|
|
For use in any Lazarus 1.x/FPC 2.x application
|
|
|
|
Files needed to install component
|
|
=================================================
|
|
uspalshabout.lpk usplashabout.pas,uversion.pas,
|
|
license.lrs,masks.lrs,splashabout_ico.lrs (resource files)
|
|
|
|
Optional Files in the same folder as your application (ONLY if Graphics=saExternalFiles)
|
|
========================================================================================
|
|
Optional: <mysplashgraphic>.(bmp/jpg/gif)
|
|
Optional: <mysplashicon>.ico
|
|
Optional: <mymaskmonographic>.bmp
|
|
Optional: <mymaskcolorgraphic>.jpg
|
|
|
|
How to use in your project (see example project)
|
|
================================================
|
|
Use the Property Editor to set propertes and call ShowSplash and/or ShowAbout in your form code
|
|
|
|
== Property tips ==
|
|
// If SplashAbout1.DelaySeconds set to zero, then SplashScreen will close only when your application becomes idle
|
|
// TitleStyle allows you to use default Application or Form icons and titles or set your own (via Icon and UserTitle properties)
|
|
//
|
|
// == External files or built-in resources? (Graphics=saResources or Graphics=saExternalFiles) ==
|
|
// Using saResources will increase the size of your executable whereas saExternalFiles will not
|
|
// HOWEVER any external files specified MUST be deployed in the same folder as your executable.
|
|
// If Graphics=saResources, then (optionally) set the properties:
|
|
// BitmapBackGround, BitmapMaskColor, BitmapMaskMono and Icon
|
|
// If Graphics=saExternalFiles then (optionally) set the properties
|
|
// ExternalFileBackGroundImage,ExternalFileIcon,ExternalFileMaskColorImage and ExternalFileMonoImage
|
|
// * Note that ExternalFileOptions flags can control which are displayed
|
|
// The optional properties MaskMonoImage and MaskColour Image
|
|
// can make a shaped splash form (See the example app for ideas)
|
|
// For MaskMonoImage, optimum source: .BMP image, 2-bit color depth or more, black area=invisible, white area=visible. Size >= 320 x 240
|
|
// If a jpg file is specified by mistake, it will be converted to a (large filesize 24bbp!) .bmp and saved to disk on first run.
|
|
// For MaskColorImage, use a standard colour JPG file with a white background
|
|
// This allows a shaped jpg image to be shown as a splash screen - very dramatic!
|
|
//
|
|
// SplashAbout1.LicenseFile ; // Default is for Licence button to be absent on ShowAbout method
|
|
// SplashAbout1.CreditText:='Freeware by minesadorada'; // OPTIONAL: Default is no text
|
|
// SplashAbout1.Author:='Mines A. Dorada'; // OPTIONAL. Default is boilerplate text in LicenseFile Path
|
|
// SplashAbout1.SupportContact:='minesadorada@charcodelvalle.com'; // OPTIONAL. Default is boilerplate text in LicenseFile Path
|
|
// SplashAbout1.Description:='My description'; // Will replace build info text if ShowDescription=True
|
|
|
|
=====================================
|
|
EXAMPLE USE in the form create method
|
|
=====================================
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
SplashAbout1.ShowSplash;
|
|
end;
|
|
|
|
=============================
|
|
EXAMPLE USE in About.. button
|
|
=============================
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
begin
|
|
SplashAbout1.ShowAbout;
|
|
end;
|
|
}
|
|
uses
|
|
Buttons, Classes, Controls, Forms, Graphics, SysUtils,
|
|
LCLIntf, LCLType, LResources,
|
|
Dialogs, ExtCtrls, PropEdits, ScrollTextClass, StdCtrls, StrUtils, uversion,uPoweredBy;
|
|
|
|
type
|
|
tFormType = (fSplash, fAbout); // Same dialog used for both
|
|
// The license text is stored in the component as a resource.
|
|
// If saUserFile then a file 'license.txt' must be present in the same folder as the executeable
|
|
tLicenseFile = (saNone, saGPL, saLGPL, saMIT, saModifiedGPL, saUserFile);
|
|
// To use your own icon and title then use saUserTitle
|
|
TTitleStyleType = (saUserTitle, saForm, saApplication);
|
|
// List of built-in shaped screens. Use saUserImage for your own shaped screen.
|
|
tmasktype = (saNomask, saRoundedRect, saBigCog, saBigFlower, saBigSplash, saUserImage);
|
|
// Default is to use internal graphics resources (BitMap.. properties)
|
|
tGraphicType = (saExternalFiles, saResources);
|
|
// Default is saResizeGraphic
|
|
tResizeMode = (saNoResize, saResizeGraphic, saResizeWindow);
|
|
// Used to make up an options list (when Graphics=saExternalFiles)
|
|
tExternalFileOptionsType = (saExternalBackground, saExternalIcon,
|
|
saExternalMaskColorImage, saExternalMaskMonoImage);
|
|
tExternalFileOptions = set of tExternalFileOptionsType;
|
|
// Used in property editor (TypeInfo cast)
|
|
tSplashAboutString = string;
|
|
|
|
const
|
|
C_DEFAULTSPLASHWIDTH = 320;
|
|
C_DEFAULTSPLASHHEIGHT = 240;
|
|
C_LINUXEXTRASPLASHHEIGHT = 40;
|
|
C_DEFAULTSPLASHHEIGHT_LINUX = C_DEFAULTSPLASHHEIGHT + C_LINUXEXTRASPLASHHEIGHT;
|
|
|
|
C_DEFAULTLICENSEFORMWIDTH = 500;
|
|
C_DEFAULTLICENSEFORMWIDTH_LINUX = C_DEFAULTLICENSEFORMWIDTH + 100;
|
|
C_DEFAULTLICENSEFORMHEIGHT = 400;
|
|
C_DEFAULTLICENSEFORMHEIGHT_LINUX = C_DEFAULTLICENSEFORMHEIGHT + 50;
|
|
C_SPLASHABOUT_ERROR = 'SplashAbout Component Error';
|
|
C_SPLASHABOUT_VERSION = '1.4.3.0';
|
|
|
|
type
|
|
TSplashAbout = class(TComponent)
|
|
private
|
|
fSplashForm: TForm;
|
|
fFormType: tFormType;
|
|
fIcon: TIcon;
|
|
fDelaySeconds: integer;
|
|
fTitleString: string;
|
|
fBackGroundColor: TColor;
|
|
fExternalFileIcon, fExternalFileBackGroundImage, fExternalFileMaskMonoImage,
|
|
fExternalFileMaskColorImage: string;
|
|
fBackGroundBitmap, fMaskMonoBitmap, fMaskColorBitmap: TBitMap;
|
|
fVersionInfoString: string;
|
|
fAppVersionString: string;
|
|
fLicenseFile: tLicenseFile;
|
|
fLicenseTypeString: string;
|
|
fOrganisationString: string;
|
|
fAuthorString: string;
|
|
fSupportContactString: string;
|
|
fCloseOnIdle: boolean;
|
|
szLicenseFile: string;
|
|
fTitleStyle: TTitleStyleType;
|
|
fShowDescription: boolean;
|
|
fDescriptionStringList: TStrings;
|
|
fFormTitleString: string;
|
|
fFormIcon: TIcon;
|
|
fMaskType: tMaskType;
|
|
fAboutString: tSplashAboutString;
|
|
fGraphicType: tGraphicType;
|
|
fExternalFileOptions: tExternalFileOptions;
|
|
fFont: TFont;
|
|
fPoweredBy:TPoweredBy;
|
|
|
|
// Credits screen vars
|
|
fCreditLines: TStrings;
|
|
fShowCreditButton: boolean;
|
|
fCreditsTextfileName: string;
|
|
|
|
fFormSplashWidth, fFormSplashHeight: integer;
|
|
fFormAboutWidth, fFormAboutHeight: integer;
|
|
fFormSplashTextAlign: TAlignment;
|
|
fFormAboutTextAlign: TAlignment;
|
|
fVersionString: string;
|
|
fResizeMode: tResizeMode;
|
|
|
|
fShowPoweredBy: boolean;
|
|
|
|
// Used by various buttons to close Splash or About foerm
|
|
procedure CloseForm(Sender: TObject);
|
|
// Main method to construct a splash or about dialog
|
|
procedure ShowForm;
|
|
// Called From ShowForm
|
|
procedure ShowLicense(Sender: TObject);
|
|
// Called when credits button is clicked
|
|
procedure ShowCredits(Sender: TObject);
|
|
// Only called is a developer specifies a jpg 2-colour image by mistake
|
|
function MakeBMPfromJPG(var JPGFilePath: string): boolean;
|
|
// Used when DelaySeconds=0
|
|
procedure ApplicationOnIdle(Sender: TObject; var {%H-}Done: boolean);
|
|
// Property Set procedure
|
|
procedure SetBackGroundBitmap(const AValue: TBitmap);
|
|
// Property Set procedure
|
|
procedure SetMaskMonoBitmap(const AValue: TBitmap); platform;
|
|
// Property Set procedure
|
|
procedure SetMaskColorBitmap(const AValue: TBitmap); platform;
|
|
// Property Set procedure
|
|
procedure SetStrings(const AValue: TStrings);
|
|
// Property Set procedure
|
|
procedure SetCreditLines(const AValue: TStrings);
|
|
// Property Set procedure
|
|
procedure SetFont(const AValue: TFont);
|
|
protected
|
|
public
|
|
// Called when component is dropped onto a form
|
|
constructor Create(AOwner: TComponent); override;
|
|
// Called when component is deleted from a form
|
|
destructor Destroy; override;
|
|
// Usually called in Form.Create
|
|
procedure ShowSplash;
|
|
// Usually called from Help/About menu click
|
|
procedure ShowAbout;
|
|
published
|
|
// Duration of the Splash screen
|
|
property DelaySeconds: integer read fDelaySeconds write fDelaySeconds default 2;
|
|
// Colour of the Splash and About dialogs if no background image specified
|
|
property BackGroundColor: TColor read fBackGroundColor
|
|
write fBackGroundColor default clSkyBlue;
|
|
// If Titlestyle is set to saUserTitle this .ico file can be displayed
|
|
property ExternalFileIcon: string read fExternalFileIcon write fExternalFileIcon;
|
|
// If Graphics is set to saExternalFiles this .jpg will be used
|
|
property ExternalFileBackGroundImage: string
|
|
read fExternalFileBackGroundImage write fExternalFileBackGroundImage;
|
|
// If Graphics is set to saExternalFiles this .bmp will be used
|
|
property ExternalFileMaskMonoImage: string
|
|
read fExternalFileMaskMonoImage write fExternalFileMaskMonoImage; platform;
|
|
// If Graphics is set to saExternalFiles this .jpg will be used
|
|
property ExternalFileMaskColorImage: string
|
|
read fExternalFileMaskColorImage write fExternalFileMaskColorImage; platform;
|
|
// These options allow you to experiment with external file settings
|
|
property ExternalFileOptions: tExternalFileOptions
|
|
read fExternalFileOptions write fExternalFileOptions default
|
|
[saExternalBackground, saExternalIcon, saExternalMaskColorImage,
|
|
saExternalMaskMonoImage];
|
|
// Sets the font for all text on the Splash and About dialogs
|
|
property Font: TFont read fFont write SetFont;
|
|
// If Graphics is set to saResources this bitmap will be used
|
|
property BitmapBackGround: TBitMap read fBackGroundBitmap write SetBackGroundBitmap;
|
|
// If Graphics is set to saResources this bitmap will be used
|
|
property BitmapMaskMono: TBitmap read fMaskMonoBitmap write SetMaskMonoBitmap;
|
|
platform;
|
|
// If Graphics is set to saResources this bitmap will be used
|
|
property BitmapMaskColor: TBitMap read fMaskColorBitmap write SetMaskColorBitmap;
|
|
platform;
|
|
// User icon used if Graphics=saResources and TitleStyle=saUserTitle
|
|
property Icon: TIcon read fIcon write fIcon;
|
|
// Default:saNoMask Set saUserImage to use a shaped splash screen and saNoMask for a standard screen
|
|
property MaskType: tMaskType read fMaskType write fMaskType default saNomask;
|
|
// If not saNone then a [License] button will be available on the About Dialog
|
|
property LicenseFile: tLicenseFile
|
|
read fLicenseFile write fLicenseFile default saNone;
|
|
// Determines whether to use built-in bitmaps or external files
|
|
property Graphics: tGraphicType read fGraphicType write fGraphicType default
|
|
saResources;
|
|
// Your Organisation is displayed in the About Dialog and the License screen
|
|
property Organisation: string read fOrganisationString write fOrganisationString;
|
|
// Displayed in the license screen
|
|
property SupportContact: string read fSupportContactString
|
|
write fSupportContactString;
|
|
// Displayed in the license screen
|
|
property Author: string read fAuthorString write fAuthorString;
|
|
// saApplication uses the Application properties, saForm uses the Form properties
|
|
property TitleStyle: TTitleStyleType
|
|
read fTitleStyle write fTitleStyle default saApplication;
|
|
// If saTitleStyle=saUserTitle then this value is displayed
|
|
property UserTitle: string read fTitleString write fTitleString;
|
|
// If TRUE then the Description property text is displayed in the About dialog
|
|
property ShowDescription: boolean read fShowDescription write fShowDescription;
|
|
// If ShowDescription=TRUE then this text is displayed in the About dialog
|
|
property Description: TStrings read fDescriptionStringList write SetStrings;
|
|
// Double-click or click the ellipsis button
|
|
property About: tSplashAboutString read fAboutString;
|
|
// If shaped form then this property is ignored
|
|
property FormSplashWidth: integer read fFormSplashWidth
|
|
write fFormSplashWidth default C_DEFAULTSPLASHWIDTH;
|
|
// If shaped form then this property is ignored
|
|
property FormSplashHeight: integer read fFormSplashHeight
|
|
write fFormSplashHeight default C_DEFAULTSPLASHHEIGHT;
|
|
// Use default value for the best layout
|
|
property FormAboutWidth: integer read fFormAboutWidth
|
|
write fFormAboutWidth default C_DEFAULTSPLASHWIDTH;
|
|
// Use default value for the best layout
|
|
property FormAboutHeight: integer read fFormAboutHeight
|
|
write fFormAboutHeight default C_DEFAULTSPLASHHEIGHT;
|
|
// Default is taCenter
|
|
property FormSplashTextAlign: TAlignment
|
|
read fFormSplashTextAlign write fFormSplashTextAlign default taCenter;
|
|
// Default is taCenter
|
|
property FormAboutTextAlign: TAlignment read fFormAboutTextAlign
|
|
write fFormAboutTextAlign default taCenter;
|
|
// Version number of SplashAbout source code
|
|
property Version: string read fVersionString;
|
|
{$IFNDEF LINUX}
|
|
// If TRUE then ShowSplash is preceded by a 'Powered by Lazarus' splash
|
|
property ShowPoweredBy: boolean
|
|
read fShowPoweredBy write fShowPoweredBy default False; platform;
|
|
{$ENDIF}
|
|
// String list for scrolling credits
|
|
property CreditLines: TStrings read fCreditLines write SetCreditLines;
|
|
// Show the Credits button?
|
|
property ShowCreditButton: boolean read fShowCreditButton write fShowCreditButton;
|
|
// If this text file is present in the executable folder the contents will be used
|
|
// to populate the scrolling Credits window
|
|
property CreditsTextfileName: string read fCreditsTextfileName
|
|
write fCreditsTextfileName;
|
|
// Affects how the background bitmap behaves
|
|
property ResizeMode: TResizeMode read fResizeMode write fResizeMode default
|
|
saResizeGraphic;
|
|
property PoweredBy:TPoweredBy read fPoweredBy write fPoweredBy;
|
|
end;
|
|
|
|
TAboutPropertyEditor = class(TClassPropertyEditor)
|
|
// Custom property editor for 'About' property
|
|
public
|
|
procedure Edit; override;
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
function GetValue: string; override;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
// Called when installing component into the Lazarus IDE
|
|
begin
|
|
{$I splashabout_ico.lrs}
|
|
// Only use for the unique type 'tSplashAboutString'
|
|
RegisterPropertyEditor(TypeInfo(tSplashAboutString),
|
|
TSplashAbout, 'About', TAboutPropertyEditor);
|
|
// Register subcomponent class property editor
|
|
RegisterPropertyEditor(TypeInfo(TPoweredBy),
|
|
TSplashAbout, 'PoweredBy', TClassPropertyEditor);
|
|
|
|
RegisterComponents('Additional', [TSplashAbout]);
|
|
end;
|
|
|
|
// == START PROPERTY EDITOR CODE FOR About PROPERTY ==
|
|
procedure TAboutPropertyEditor.Edit;
|
|
// Shows a dialog when About property is double-clicked
|
|
var
|
|
tAboutForm: TForm;
|
|
OKbutton: TBitBtn;
|
|
lbl_Description: TLabel;
|
|
sz: string;
|
|
begin
|
|
sz := 'SplashAbout component for Lazarus' + LineEnding +
|
|
'by minesadorada@charcodelvalle.com' + LineEnding + LineEnding;
|
|
sz += 'Methods:' + LineEnding;
|
|
sz += 'SplashAbout1.ShowSplash' + LineEnding;
|
|
sz += 'SplashAbout1.ShowAbout' + LineEnding;
|
|
sz += LineEnding + 'Version: ' + C_SPLASHABOUT_VERSION + LineEnding;
|
|
sz += 'License: LGPL';
|
|
tAboutForm := TForm.CreateNew(nil);
|
|
try //.. finally FreeAndNil everything
|
|
with tAboutForm do
|
|
begin
|
|
// Form
|
|
position := poScreenCenter;
|
|
borderstyle := bsToolWindow;
|
|
Caption := 'About SplashAbout Component';
|
|
formstyle := fsSystemStayOnTop;
|
|
color := clSkyBlue;
|
|
Height := 240;
|
|
Width := 320;
|
|
okbutton := TBitBtn.Create(tAboutForm);
|
|
okbutton.Kind := bkClose;
|
|
okbutton.left := (Width div 2) - okbutton.Width div 2;
|
|
okbutton.top := Height - okbutton.Height - 10;
|
|
okbutton.parent := tAboutForm;
|
|
lbl_Description := Tlabel.Create(tAboutForm);
|
|
lbl_Description.left := 8;
|
|
lbl_Description.Top := 30;
|
|
lbl_Description.Width := 304;
|
|
lbl_Description.Height := 200;
|
|
lbl_Description.Autosize := False;
|
|
lbl_Description.Alignment := taCenter;
|
|
lbl_Description.Caption := sz;
|
|
lbl_Description.parent := tAboutForm;
|
|
ShowModal;
|
|
end;
|
|
finally
|
|
FreeAndNil(lbl_Description);
|
|
FreeAndNil(okbutton);
|
|
FreeAndNil(tAboutForm);
|
|
end;
|
|
end;
|
|
|
|
function TAboutPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
// Show the ellipsis
|
|
begin
|
|
Result := [paDialog, paReadOnly];
|
|
end;
|
|
|
|
function TAboutPropertyEditor.GetValue: string;
|
|
// Override standard string read method
|
|
begin
|
|
Result := '(About)';
|
|
end;
|
|
// == END PROPERTY EDITOR CODE FOR About PROPERTY ==
|
|
|
|
|
|
destructor TSplashAbout.Destroy;
|
|
begin
|
|
Application.RemoveOnIdleHandler(@ApplicationOnIdle);
|
|
FreeAndNil(fBackGroundBitmap);
|
|
FreeAndNil(fMaskMonoBitmap);
|
|
FreeAndNil(fMaskColorBitmap);
|
|
FreeAndNil(fIcon);
|
|
FreeAndNil(fDescriptionStringList);
|
|
FreeAndNil(fFont);
|
|
FreeAndNil(fCreditLines);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
constructor TSplashAbout.Create(AOwner: TComponent);
|
|
// Initialise private vars
|
|
var
|
|
Frm: TForm;
|
|
begin
|
|
If (AOwner=Nil) then
|
|
begin
|
|
raise Exception.CreateFmt('%s : Sorry this component cannot be created in code',[C_SPLASHABOUT_ERROR]);
|
|
Exit;
|
|
end;
|
|
inherited Create(AOwner);
|
|
|
|
// From main form [Create(Self)]
|
|
if (AOwner is TForm) then
|
|
begin
|
|
Frm := AOwner as TForm;
|
|
fFormTitleString := Frm.Caption;
|
|
fFormIcon := Frm.Icon;
|
|
end;
|
|
DelaySeconds := 2;
|
|
BackGroundColor := clSkyBlue;
|
|
fAppVersionString := LineEnding;
|
|
// Use uversion unit public methods to populate (Credit: Mike Thompson)
|
|
if (GetFileVersion <> 'No build information available') then
|
|
fAppVersionString += 'Version ' + GetFileVersion + LineEnding + LineEnding;
|
|
fVersionInfoString := fAppVersionString + 'Made with: ' + GetLCLVersion;
|
|
fVersionInfoString += ' and ' + GetCompilerInfo + LineEnding;
|
|
fVersionInfoString += 'For: ' + GetTargetInfo + ' (' + GetWidgetSet + ')' + LineEnding;
|
|
fVersionInfoString += 'Last Compiled: ' + GetCompiledDate;
|
|
|
|
// Optional property values
|
|
fExternalFileBackGroundImage := '';
|
|
fExternalFileMaskMonoImage := '';
|
|
fTitleStyle := saApplication;
|
|
fTitleString := 'My Application';
|
|
fCloseOnIdle := False;
|
|
fExternalFileOptions := [saExternalBackground, saExternalIcon,
|
|
saExternalMaskColorImage, saExternalMaskMonoImage];
|
|
fGraphicType := saResources;
|
|
// Initialise property resources
|
|
fBackGroundBitmap := TBitMap.Create;
|
|
fMaskMonoBitmap := TBitMap.Create;
|
|
fMaskColorBitmap := TBitMap.Create;
|
|
fDescriptionStringList := TStringList.Create;
|
|
fIcon := TIcon.Create;
|
|
fFont := TFont.Create;
|
|
fFont.Size := 10;
|
|
fFormSplashWidth := C_DEFAULTSPLASHWIDTH;
|
|
fFormSplashHeight := C_DEFAULTSPLASHHEIGHT;
|
|
fFormAboutWidth := C_DEFAULTSPLASHWIDTH;
|
|
fFormAboutHeight := C_DEFAULTSPLASHHEIGHT;
|
|
{$IFDEF LINUX}
|
|
fFormSplashHeight := C_DEFAULTSPLASHHEIGHT_LINUX;
|
|
{$ENDIF}
|
|
fFormSplashTextAlign := taCenter;
|
|
fFormAboutTextAlign := taCenter;
|
|
fVersionString := C_SPLASHABOUT_VERSION;
|
|
fCreditLines := TStringList.Create;
|
|
fCreditsTextfileName := 'credits.txt';
|
|
fResizeMode := saResizeGraphic;
|
|
|
|
// Use tPoweredBy as a subcomponent
|
|
// Register a TClassPropertyEditor in order to display it correctly
|
|
fPoweredBy := TPoweredBy.Create(Self);
|
|
fPoweredBy.SetSubComponent(true); // Tell the IDE to store the modified properties
|
|
fPoweredBy.Name:='PoweredBy';
|
|
end;
|
|
|
|
procedure TSplashAbout.ApplicationOnIdle(Sender: TObject; var Done: boolean);
|
|
begin
|
|
if fSplashForm = nil then
|
|
exit;
|
|
if fCloseOnIdle then
|
|
if fSplashForm.Visible then
|
|
begin
|
|
fSplashForm.ModalResult := 11;//mrClose;
|
|
Done := True;
|
|
end;
|
|
end;
|
|
|
|
function TSplashAbout.MakeBMPfromJPG(var JPGFilePath: string): boolean;
|
|
// The BitmapMaskMono has to be a BMP image file (ideally 2bbp).
|
|
// If the developer sets the property to a JPG image file, then this routine
|
|
// will convert it to BMP and save it to disk. The resulting BMP file is likely
|
|
// to be a huge 24bbp file!
|
|
// WARNING! The routine overwrites any existing BMP with the name name as the old JPG
|
|
var
|
|
JPG: TJpegImage;
|
|
BMP: TBitmap;
|
|
s: string;
|
|
begin
|
|
Result := False;
|
|
if not FileExists(JPGFilePath) then
|
|
exit;
|
|
try
|
|
JPG := TJpegImage.Create;
|
|
BMP := TBitmap.Create;
|
|
try
|
|
JPG.LoadFromFile(JPGFilePath);
|
|
BMP.Assign(jpg);
|
|
s := ChangeFileExt(JPGFilePath, '.bmp');
|
|
if FileExists(s) then
|
|
ShowMessageFmt('Over-writing old %s', [s]);
|
|
BMP.SaveToFile(s);
|
|
if FileExists(s) then
|
|
begin
|
|
JPGFilePath := s;
|
|
Result := True;
|
|
end;
|
|
except
|
|
On E: Exception do
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'There is something wrong with the MaskImage JPG File' +
|
|
LineEnding + 'Error detail: ' + e.message,
|
|
mtError, [mbOK], 0);
|
|
end;
|
|
finally
|
|
BMP.Free;
|
|
JPG.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSplashAbout.ShowCredits(Sender: TObject);
|
|
var
|
|
CreditsForm: TForm;
|
|
CloseButton: TBitBtn;
|
|
ScrollWindow: TScrollTextClass;
|
|
|
|
begin
|
|
// Create a window, scroller and close button on-the-fly
|
|
CreditsForm := TForm.Create(nil);
|
|
CloseButton := TBitBtn.Create(CreditsForm);
|
|
ScrollWindow := TScrollTextClass.Create(CreditsForm);
|
|
try
|
|
with CreditsForm do
|
|
begin
|
|
position := poScreenCenter;
|
|
borderstyle := bsToolWindow;
|
|
Caption := fTitleString + ': Credits';
|
|
formstyle := fsSystemStayOnTop;
|
|
Color := clBlack; // For a black border
|
|
// Use the same window size as the License window
|
|
{$IFDEF WINDOWS}
|
|
// More compact GUI?
|
|
Width := C_DEFAULTLICENSEFORMWIDTH;
|
|
Height := C_DEFAULTLICENSEFORMHEIGHT;
|
|
{$ELSE WINDOWS}
|
|
Width := C_DEFAULTLICENSEFORMWIDTH_LINUX;
|
|
Height := C_DEFAULTLICENSEFORMHEIGHT_LINUX;
|
|
{$ENDIF}
|
|
|
|
|
|
// Close Button
|
|
CloseButton.Kind := bkClose;
|
|
CloseButton.left := (Width div 2) - CloseButton.Width div 2;
|
|
CloseButton.top := Height - CloseButton.Height - 10;
|
|
CloseButton.parent := CreditsForm;
|
|
|
|
// Scroller panel
|
|
ScrollWindow.Parent := CreditsForm;
|
|
ScrollWindow.Align := alClient;
|
|
ScrollWindow.BorderSpacing.Around := 2;
|
|
ScrollWindow.BackColor := fBackGroundColor;
|
|
ScrollWindow.Font.Assign(fFont);
|
|
|
|
// Load from string list?
|
|
if CreditLines.Count > 0 then
|
|
ScrollWindow.Lines.Assign(CreditLines);
|
|
|
|
// Load from CreditsTextFile if present
|
|
// This would overwrite any text in CreditLines
|
|
if FileExists(fCreditsTextfileName) then
|
|
ScrollWindow.Lines.LoadFromFile(fCreditsTextfileName);
|
|
|
|
// If both are empty then default text is shown.
|
|
ScrollWindow.Active := True;
|
|
// Show modally over the existing modal form
|
|
PopupParent := TForm(Sender);
|
|
ShowModal;
|
|
end;
|
|
finally
|
|
CloseButton.Free;
|
|
ScrollWindow.Free;
|
|
CreditsForm.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSplashAbout.ShowLicense(Sender: TObject);
|
|
// Triggered by License button Click
|
|
var
|
|
sLicenseString: string;
|
|
theList: TStringList;
|
|
f: integer;
|
|
LicenceForm: TForm;
|
|
lblText: TLabel;
|
|
closebuttton: TBitBtn;
|
|
r: TLResource;
|
|
begin
|
|
// Set to resource name in license.lrs
|
|
case fLicenseFile of
|
|
saNone: szLicenseFile := '';
|
|
saGPL: szLicenseFile := 'gpl.txt';
|
|
saLGPL: szLicenseFile := 'lgpl.txt';
|
|
saMIT: szLicenseFile := 'mit.txt';
|
|
saModifiedgpl: szLicenseFile := 'modifiedgpl.txt';
|
|
saUserFile: szLicenseFile := 'license.txt';
|
|
end;
|
|
if fLicenseFile = saNone then
|
|
Exit;
|
|
|
|
// Use a string list to split the text file into lines
|
|
theList := TStringList.Create;
|
|
// Create a window, label and close button on-the-fly
|
|
LicenceForm := TForm.Create(nil);
|
|
lblText := TLabel.Create(LicenceForm);
|
|
closebuttton := TBitBtn.Create(LicenceForm);
|
|
// Load up the text into variable 'sLicenseString'
|
|
sLicenseString := LineEnding + LineEnding + fTitleString + LineEnding;
|
|
try
|
|
try
|
|
if (fLicenseFile = saUserFile) then
|
|
begin
|
|
theList.LoadFromFile(szLicenseFile);
|
|
sLicenseString += LineEnding;
|
|
if (theList.Count = 0) then
|
|
raise Exception.CreateFmt('%s does not contain any text', [szLicenseFile]);
|
|
for f := 0 to TheList.Count - 1 do
|
|
sLicenseString += TheList[f] + LineEnding;
|
|
end
|
|
else
|
|
begin
|
|
// Load license text from resource string
|
|
r := LazarusResources.Find(szLicenseFile);
|
|
if r = nil then
|
|
raise Exception.Create('Resource datafile license.lrs is missing');
|
|
thelist.Add(r.Value);
|
|
for f := 0 to TheList.Count - 1 do
|
|
sLicenseString += TheList[f] + LineEnding;
|
|
end;
|
|
except
|
|
On e: Exception do
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'There is something wrong with the Licence text', mtError, [mbOK], 0);
|
|
end;
|
|
|
|
// Replace boilerplate text if possible
|
|
sLicenseString := AnsiReplaceText(sLicenseString, '<year>',
|
|
{$I %DATE%}
|
|
);
|
|
sLicenseString := AnsiReplaceText(sLicenseString, '<name of author>', fAuthorString);
|
|
sLicenseString := AnsiReplaceText(sLicenseString, '<contact>',
|
|
'(' + fSupportContactString + ')');
|
|
sLicenseString := AnsiReplaceText(sLicenseString, '<copyright holders>',
|
|
fAuthorString);
|
|
|
|
// Make up the form window and controls
|
|
with LicenceForm do
|
|
begin
|
|
// Form
|
|
{$IFDEF WINDOWS}
|
|
// More compact GUI?
|
|
Width := C_DEFAULTLICENSEFORMWIDTH;
|
|
Height := C_DEFAULTLICENSEFORMHEIGHT;
|
|
{$ELSE WINDOWS}
|
|
Width := C_DEFAULTLICENSEFORMWIDTH_LINUX;
|
|
Height := C_DEFAULTLICENSEFORMHEIGHT_LINUX;
|
|
{$ENDIF}
|
|
// autosize:=true;
|
|
// If you enable autosize, the button placement goes awry!
|
|
|
|
// The Modified GPL has an extra clause
|
|
if (szLicenseFile = 'modifiedgpl.txt') or
|
|
(Pos('As a special exception', sLicenseString) > 0) then
|
|
Height := Height + 100;
|
|
position := poScreenCenter;
|
|
borderstyle := bsToolWindow;
|
|
Caption := fTitleString + ': Licensing';
|
|
formstyle := fsSystemStayOnTop;
|
|
|
|
// Label
|
|
lblText.Align := alClient;
|
|
lblText.Alignment := taCenter;
|
|
lblText.Caption := sLicenseString;
|
|
lblText.Parent := LicenceForm;
|
|
|
|
// Close Button
|
|
closebuttton.Kind := bkClose;
|
|
closebuttton.left := (Width div 2) - closebuttton.Width div 2;
|
|
closebuttton.top := Height - closebuttton.Height - 10;
|
|
closebuttton.parent := LicenceForm;
|
|
// Show modally over the existing modal form
|
|
PopupParent := TForm(Sender);
|
|
ShowModal;
|
|
end;
|
|
finally
|
|
// Free up all component created resources from memory
|
|
FreeAndNil(theList);
|
|
FreeAndNil(lblText);
|
|
FreeAndNil(closebuttton);
|
|
FreeAndNil(LicenceForm);
|
|
end;
|
|
end;
|
|
|
|
procedure TSplashAbout.CloseForm(Sender: TObject);
|
|
// Triggered by a Timer.OnTimer event or CloseButton.Click or OnClick
|
|
begin
|
|
fSplashForm.Close; // Hide and destroy
|
|
end;
|
|
|
|
procedure TSplashAbout.ShowSplash;
|
|
// Set the mode, then create and show the form
|
|
begin
|
|
fFormType := fSplash;
|
|
ShowForm;
|
|
end;
|
|
|
|
procedure TSplashAbout.ShowAbout;
|
|
// Set the mode, then create and show the form
|
|
begin
|
|
fFormType := fAbout;
|
|
ShowForm;
|
|
end;
|
|
|
|
procedure TSplashAbout.ShowForm;
|
|
// Main method
|
|
// Construct a form and show it modally
|
|
// Controls vary according to fFormType variable
|
|
const
|
|
TEXT_MARGIN = 30; // Pixels from left and right
|
|
var
|
|
OKButton, LicenseButton, CreditsButton: TBitBtn;
|
|
Delaytimer, scrolltimer: TTimer;
|
|
lbl_Title, lbl_VersionInfo: TLabel;
|
|
img_icon, img_background: TImage;
|
|
bevel: TBevel;
|
|
MyBitMap: TBitMap;
|
|
FormRect: TRect;
|
|
sVersionInfoString: string;
|
|
iFormHeight, iFormWidth: integer;
|
|
szMaskName: string;
|
|
bUsingResourceMask, bMaskPSplash: boolean;
|
|
iCount: integer;
|
|
bLicenseButtonVisible, bCreditsButtonVisible: boolean;
|
|
|
|
label
|
|
NOTEXT; // Used in a GoTo
|
|
|
|
begin
|
|
|
|
// Show 'Powered by Lazarus?'
|
|
if ((fShowPoweredBy = True) and ((fFormType = fSplash))) then
|
|
fPoweredBy.ShowPoweredByForm;
|
|
|
|
bMaskPSplash := False; // Toggle used in background image code
|
|
bUsingResourceMask := False; // True if saRoundedRect etc are used
|
|
//Establish License
|
|
case fLicenseFile of
|
|
saNone:
|
|
begin
|
|
szLicenseFile := '';
|
|
fLicenseTypeString := '';
|
|
end;
|
|
saGPL:
|
|
begin
|
|
szLicenseFile := 'gpl.txt';
|
|
fLicenseTypeString := 'GPL License';
|
|
end;
|
|
saLGPL:
|
|
begin
|
|
szLicenseFile := 'lgpl.txt';
|
|
fLicenseTypeString := 'Library GPL License';
|
|
end;
|
|
saMIT:
|
|
begin
|
|
szLicenseFile := 'mit.txt';
|
|
fLicenseTypeString := 'MIT License';
|
|
end;
|
|
saModifiedgpl:
|
|
begin
|
|
szLicenseFile := 'modifiedgpl.txt';
|
|
fLicenseTypeString := 'Modified GPL License';
|
|
end;
|
|
saUserFile:
|
|
begin
|
|
szLicenseFile := 'license.txt';
|
|
fLicenseTypeString := 'Proprietry License';
|
|
end;
|
|
end;
|
|
// Set resource name if appropriate, else filename of user image
|
|
case fMaskType of
|
|
saNoMask: szMaskName := 'none';
|
|
saUserImage: szMaskName := fExternalFileMaskMonoImage;
|
|
saRoundedRect: szMaskName := 'roundedrect';
|
|
saBigCog: szMaskName := 'bigcog';
|
|
saBigFlower: szMaskName := 'bigflower';
|
|
saBigSplash: szMaskName := 'bigsplash';
|
|
end;
|
|
|
|
// Temporarily create the form and controls
|
|
fSplashForm := TForm.CreateNew(nil);
|
|
if (fTitleStyle = saApplication) then
|
|
fTitleString := Application.Title;
|
|
if (fTitleStyle = saForm) then
|
|
fTitleString := fFormTitleString;
|
|
|
|
fSplashForm.Font := fFont;
|
|
// The created form is parent to all the controls
|
|
bevel := TBevel.Create(fSplashForm);
|
|
OKButton := TBitBtn.Create(fSplashForm);
|
|
LicenseButton := TBitBtn.Create(fSplashForm);
|
|
CreditsButton := TBitBtn.Create(fSplashForm);
|
|
Delaytimer := TTimer.Create(fSplashForm);
|
|
Scrolltimer := TTimer.Create(fSplashForm);
|
|
lbl_Title := TLabel.Create(fSplashForm);
|
|
lbl_VersionInfo := TLabel.Create(fSplashForm);
|
|
img_icon := TImage.Create(fSplashForm);
|
|
img_background := TImage.Create(fSplashForm);
|
|
MyBitmap := TBitMap.Create;
|
|
iFormHeight := fFormSplashHeight;
|
|
iFormWidth := fFormSplashWidth;
|
|
if fFormType = fAbout then
|
|
begin
|
|
iFormHeight := fFormAboutHeight;
|
|
iFormWidth := fFormAboutWidth;
|
|
end;
|
|
lbl_Title.ParentFont := True;
|
|
lbl_VersionInfo.ParentFont := True;
|
|
|
|
// Now set positions and properties
|
|
try //.. finally FreeAndNil everything
|
|
with fSplashForm do
|
|
begin
|
|
// Form
|
|
position := poScreenCenter;
|
|
if fFormType = fAbout then
|
|
borderstyle := bsToolWindow
|
|
else
|
|
borderstyle := bsnone;
|
|
Caption := 'About ' + fTitleString;
|
|
formstyle := fsSystemStayOnTop;
|
|
color := fBackGroundColor;
|
|
// Set constraints so that if ResizeMode=ResizeWindow
|
|
// then the form can't disappear nor overwhelm the screen
|
|
Constraints.MaxWidth := 1024;
|
|
Constraints.MaxHeight := 768;
|
|
Constraints.MinWidth := 320;
|
|
Constraints.MinHeight := 240;
|
|
Height := iFormHeight;
|
|
Width := iFormWidth;
|
|
|
|
|
|
|
|
// Shaped form?
|
|
// Form is sized to mask image (MUST be BMP file)
|
|
// Text is centred in a 320 x 240 invisible frame
|
|
{$IFNDEF LINUX}// Problem with Canvas.Draw in linux!
|
|
|
|
// Skip this mask code block if MaskType is saNoMask
|
|
if (fFormType = fSplash) and (fMaskType <> saNoMask) then
|
|
begin
|
|
// Deal with user-supplied image first
|
|
if (fMaskType = saUserImage) then
|
|
|
|
if ((fGraphicType = saExternalFiles) and
|
|
(saExternalMaskMonoImage in fExternalFileOptions)) then
|
|
if (FileExists(fExternalFileMaskMonoImage)) then
|
|
begin
|
|
// Try to convert a jpg file if specified as such
|
|
if ExtractFileExt(fExternalFileMaskMonoImage) = '.jpg' then
|
|
if MakeBMPfromJPG(fExternalFileMaskMonoImage) = False then
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'There is something wrong with the MaskImage or MaskPImage File',
|
|
mtError, [mbOK], 0)
|
|
else
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'The MaskImage should be a .BMP file. Your jpg has been converted and saved as a bmp. Please amend the property.',
|
|
mtInformation, [mbOK], 0);
|
|
// Load the user image into the BitMap
|
|
MyBitMap.LoadFromFile(fExternalFileMaskMonoImage);
|
|
//MyBitmap.SetSize(iFormWidth,iFormHeight);
|
|
end
|
|
else
|
|
// Looks like the specified user image isn't in the application folder
|
|
begin
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'Cannot find MaskImage ' + fExternalFileMaskMonoImage,
|
|
mtError, [mbOK], 0);
|
|
exit;
|
|
end;
|
|
|
|
// Deal with Bitmap resource
|
|
if (fGraphicType = saResources) then
|
|
if Assigned(fMaskMonoBitmap) then
|
|
begin
|
|
MyBitMap.Assign(fMaskMonoBitmap);
|
|
// MyBitmap.SetSize(iFormWidth,iFormHeight);
|
|
end;
|
|
|
|
// Stock image specified, so load from masks.lrs
|
|
if (fMaskType <> saUserImage) then
|
|
begin
|
|
MyBitmap.LoadFromLazarusResource(szMaskName);
|
|
bUsingResourceMask := True;
|
|
end;
|
|
|
|
// Now to use the loaded BitMap
|
|
try
|
|
// ShowMessageFmt('MyBitMap.Height = %d,MyBitMap.Width=%d',[MyBitMap.Height,MyBitMap.Width]);
|
|
if MyBitMap.Height >= iFormHeight then
|
|
iFormHeight := MyBitMap.Height;
|
|
if MyBitMap.Width >= iFormWidth then
|
|
iFormWidth := MyBitMap.Width;
|
|
|
|
MyBitMap.Transparent := True;
|
|
MyBitMap.TransparentColor := clBlack;
|
|
Height := iFormHeight;
|
|
Width := iFormWidth;
|
|
FormRect.Top := 0;
|
|
FormRect.left := 0;
|
|
FormRect.Right := Width;
|
|
FormRect.Bottom := Height;
|
|
// Use StretchDraw
|
|
Canvas.StretchDraw(FormRect, MyBitmap);
|
|
// Canvas.Draw(0, 0, MyBitMap);
|
|
// raises Floating Point Error in 64-bit Nix (!??)
|
|
SetShape(MyBitMap);
|
|
bevel.Visible := False;
|
|
except
|
|
On e: Exception do
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'There is something wrong with the MaskMonoImage or MaskColourImage File' +
|
|
LineEnding + 'Error detail: ' + e.message,
|
|
mtError, [mbOK], 0);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
// Delay Timer
|
|
if fFormType = fSplash then
|
|
begin
|
|
if fDelaySeconds = 0 then
|
|
fCloseOnIdle := True
|
|
else
|
|
fCloseOnIdle := False;
|
|
if FCloseOnIdle then
|
|
Application.AddOnIdleHandler(@ApplicationOnIdle)
|
|
else
|
|
begin
|
|
// Fix negative values
|
|
if fDelaySeconds < 1 then
|
|
fDelaySeconds := 1;
|
|
// Fix developer mistakenly specifying milliseconds
|
|
if fDelaySeconds > 1000 then
|
|
fDelaySeconds := fDelaySeconds div 1000;
|
|
delaytimer.Interval := fDelaySeconds * 1000;
|
|
delaytimer.OnTimer := @CloseForm;
|
|
delaytimer.Enabled := True;
|
|
end;
|
|
end;
|
|
|
|
// bevel
|
|
// Controls are placed relative to the bevel window
|
|
if fFormType = fAbout then
|
|
begin
|
|
bevel.Width := fFormAboutWidth;
|
|
bevel.Height := fFormAboutHeight;
|
|
end
|
|
else
|
|
begin
|
|
bevel.Width := fFormSplashWidth;
|
|
bevel.Height := fFormSplashHeight;
|
|
end;
|
|
if iFormHeight > bevel.Height then
|
|
bevel.Top := (iFormHeight - bevel.Height) div 2
|
|
else
|
|
bevel.Top := 0;
|
|
if iFormWidth > bevel.Width then
|
|
bevel.Left := (iFormWidth - bevel.Width) div 2
|
|
else
|
|
bevel.Left := 0;
|
|
bevel.BorderSpacing.Around := 4;
|
|
bevel.BorderSpacing.InnerBorder := 4;
|
|
bevel.Parent := fSplashForm;
|
|
bevel.onClick := @CloseForm;
|
|
|
|
// BackGround image - load from file or resource
|
|
if ((fResizeMode = saResizeGraphic) or (bUsingResourceMask = True)) then
|
|
img_background.Stretch := True
|
|
else
|
|
img_background.Stretch := False;
|
|
|
|
img_background.Align := alClient;
|
|
img_background.Parent := fSplashForm;
|
|
img_background.SendToBack;
|
|
|
|
if ((fGraphicType = saExternalFiles) and
|
|
(FileExists(fExternalFileBackGroundImage))) or
|
|
((fGraphicType = saResources) and (Assigned(fBackGroundBitmap))) then
|
|
begin
|
|
try
|
|
if ((fGraphicType = saExternalFiles) and
|
|
(saExternalBackground in fExternalFileOptions)) then
|
|
img_background.Picture.LoadFromFile(fExternalFileBackGroundImage);
|
|
if (fGraphicType = saResources) then
|
|
img_background.Picture.Assign(fBackGroundBitmap);
|
|
|
|
|
|
if (fResizeMode = saResizeWindow) then
|
|
begin
|
|
if (fGraphicType = saResources) then
|
|
begin
|
|
// Expand the form to suit the image
|
|
iFormHeight := fBackGroundBitmap.Height;
|
|
iFormWidth := fBackGroundBitmap.Width;
|
|
end
|
|
else
|
|
begin
|
|
// Expand the form to suit the image
|
|
iFormHeight := img_background.Height;
|
|
iFormWidth := img_background.Width;
|
|
end;
|
|
Height := iFormHeight;
|
|
Width := iFormWidth;
|
|
bevel.Align := alClient;
|
|
end;
|
|
|
|
except
|
|
On e: Exception do
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'There is something wrong with the Background Image', mtError, [mbOK], 0);
|
|
end;
|
|
end;
|
|
|
|
|
|
// In splash screen override BackGroundImage with MaskColorImage?
|
|
if (fFormType = fSplash) and (fMaskType = saUserImage) then
|
|
begin
|
|
if (fGraphicType = saExternalFiles) then
|
|
// Check images exist
|
|
if (FileExists(fExternalFileMaskColorImage)) and
|
|
(FileExists(fExternalFileMaskMonoImage)) and
|
|
(saExternalMaskColorImage in fExternalFileOptions) and
|
|
(saExternalMaskMonoImage in fExternalFileOptions) then
|
|
begin
|
|
try
|
|
img_background.Picture.LoadFromFile(fExternalFileMaskColorImage);
|
|
bMaskPSplash := True;
|
|
// Triggers GoTo statement that skips text and icon elements
|
|
except
|
|
On e: Exception do
|
|
MessageDlg(C_SPLASHABOUT_ERROR,
|
|
'There is something wrong with the External mask color Image',
|
|
mtError, [mbOK], 0);
|
|
end;
|
|
end;
|
|
if (fGraphicType = saResources) and Assigned(fMaskColorBitmap) then
|
|
begin
|
|
img_background.Picture.Assign(fMaskColorBitmap);
|
|
bMaskPSplash := True;
|
|
end;
|
|
end;
|
|
if bMaskPSplash then
|
|
begin
|
|
// Mask images should not resize the form
|
|
img_background.Stretch := True;
|
|
Height := iFormHeight;
|
|
Width := iFormWidth;
|
|
bevel.Align := alClient;
|
|
end;
|
|
// If a shaped mask with image is the splash screen then don't display any text or icon
|
|
if bMaskPSplash then
|
|
goto NOTEXT;
|
|
|
|
// Title
|
|
if fFormType = fSplash then
|
|
begin
|
|
lbl_Title.Top := bevel.Top + 64;
|
|
lbl_Title.Left := bevel.Left + TEXT_MARGIN;
|
|
lbl_Title.AutoSize := False;
|
|
lbl_Title.Width := bevel.Width - (TEXT_MARGIN * 2);
|
|
lbl_Title.Font := fFont;
|
|
lbl_Title.Font.Style := [fsBold];
|
|
lbl_Title.Font.Size := 12;
|
|
lbl_Title.Height := 32;
|
|
lbl_Title.Alignment := fFormSplashTextAlign;
|
|
if (fTitleString = '') then
|
|
lbl_Title.Caption := Application.Title
|
|
else
|
|
lbl_Title.Caption := fTitleString;
|
|
lbl_Title.Parent := fSplashForm;
|
|
end;
|
|
|
|
|
|
// Icon
|
|
// Icon can come from: Icon property, External file, Form or Application
|
|
img_icon.Width := 32;
|
|
img_icon.Height := 32;
|
|
img_icon.Top := bevel.Top + 20;
|
|
img_icon.Left := bevel.left + ((bevel.Width - 32) - 20);
|
|
img_icon.Stretch := True;
|
|
img_icon.Parent := fSplashForm;
|
|
|
|
// Fallback is to the Application icon, then Form icon, then nil.
|
|
try
|
|
// A new Application is always assigned a default icon
|
|
if (fTitleStyle = saApplication) then
|
|
if Assigned(Application.Icon) then
|
|
img_icon.Picture.Icon := Application.Icon;
|
|
|
|
// The Form may not have an icon
|
|
if (fTitleStyle = saForm) then
|
|
if (fFormIcon = nil) then
|
|
img_icon.Picture.Icon := fFormIcon
|
|
else
|
|
if Assigned(Application.Icon) then
|
|
img_icon.Picture.Icon := Application.Icon;
|
|
|
|
// Fall back to application and form icons if necessary
|
|
if (fTitleStyle = saUserTitle) then
|
|
begin
|
|
if ((fGraphicType = saExternalFiles) and
|
|
(saExternalIcon in fExternalFileOptions)) then
|
|
begin
|
|
if FileExists(fExternalFileIcon) then
|
|
begin
|
|
fIcon.LoadFromFile(fExternalFileIcon);
|
|
img_icon.Picture.Icon := fIcon;
|
|
end
|
|
else
|
|
if (fFormIcon <> nil) then
|
|
img_icon.Picture.Icon := fFormIcon
|
|
else
|
|
if Assigned(Application.Icon) then
|
|
img_icon.Picture.Icon := Application.Icon;
|
|
end;
|
|
|
|
|
|
if (fGraphicType = saResources) then
|
|
if Assigned(fIcon) then
|
|
img_icon.Picture.Icon := fIcon
|
|
else
|
|
if (fFormIcon <> nil) then
|
|
img_icon.Picture.Icon := fFormIcon
|
|
else
|
|
if Assigned(Application.Icon) then
|
|
img_icon.Picture.Icon := Application.Icon;
|
|
end;
|
|
|
|
except
|
|
On e: Exception do
|
|
MessageDlg(C_SPLASHABOUT_ERROR, 'There is something wrong with the Icon',
|
|
mtError, [mbOK], 0);
|
|
end;
|
|
|
|
// About dialog buttons
|
|
// For code clarity, use these flags
|
|
bCreditsButtonVisible := False;
|
|
bLicenseButtonVisible := False;
|
|
// Close Button (positioned in the centre)
|
|
if fFormType = fAbout then
|
|
begin
|
|
OKButton.Kind := bkClose;
|
|
OKButton.left := (Width div 2) - OKButton.Width div 2;
|
|
OKButton.top := Height - OKButton.Height - 10;
|
|
OKButton.parent := fSplashForm;
|
|
// Do we need to show the Credits and/or License buttons?
|
|
if (fShowCreditButton = True) then
|
|
bCreditsButtonVisible := True;
|
|
// License Button
|
|
// Don't show if LicenseFile=saNone or LicenseFile=saUserText and 'license.txt' is missing
|
|
if (fLicenseFile <> saUserFile) or
|
|
((fLicenseFile = saUserFile) and (FileExists(szLicenseFile))) then
|
|
if (fLicenseFile <> saNone) then
|
|
bLicenseButtonVisible := True;
|
|
// License button
|
|
if bLicenseButtonVisible then
|
|
// Put it on the right
|
|
begin
|
|
LicenseButton.Top := OKButton.Top;
|
|
LicenseButton.Caption := 'License...';
|
|
LicenseButton.left := Width - LicenseButton.Width - 10;
|
|
LicenseButton.OnClick := @ShowLicense;
|
|
LicenseButton.Parent := fSplashForm;
|
|
end;
|
|
// Credits button
|
|
if bCreditsButtonVisible then
|
|
// Put it on the right
|
|
begin
|
|
CreditsButton.Kind := bkCustom;
|
|
CreditsButton.top := OKButton.top;
|
|
CreditsButton.Left := Width - CreditsButton.Width - 10;
|
|
;
|
|
CreditsButton.Caption := 'Credits..';
|
|
CreditsButton.OnClick := @ShowCredits;
|
|
CreditsButton.parent := fSplashForm;
|
|
end;
|
|
// Reposition the various buttons?
|
|
if (bLicenseButtonVisible and bCreditsButtonVisible) then
|
|
begin
|
|
CreditsButton.Left := LicenseButton.Left - CreditsButton.Width;
|
|
OKButton.left := CreditsButton.Left - OKButton.Width;
|
|
end;
|
|
end;
|
|
|
|
|
|
// Version Info or Description
|
|
lbl_VersionInfo.Autosize := False;
|
|
lbl_VersionInfo.WordWrap := True;
|
|
lbl_VersionInfo.Left := bevel.left + TEXT_MARGIN;
|
|
lbl_VersionInfo.Width := bevel.Width - TEXT_MARGIN * 2;
|
|
lbl_VersionInfo.Height := bevel.Height - 50;
|
|
if fFormType = fAbout then
|
|
lbl_VersionInfo.Alignment := fFormAboutTextAlign
|
|
else
|
|
lbl_VersionInfo.Alignment := fFormSplashTextAlign;
|
|
|
|
sVersionInfoString := '';
|
|
if fFormType = fAbout then
|
|
sVersionInfoString += fTitleString;
|
|
if fOrganisationString <> '' then
|
|
sVersionInfoString += LineEnding + fOrganisationString;
|
|
|
|
// Show description or VersionInfo?
|
|
if (fShowDescription = True) then
|
|
begin
|
|
sVersionInfoString += LineEnding + fAppVersionString;
|
|
if (fDescriptionStringList.Count > 0) then
|
|
for iCount := 0 to fDescriptionStringList.Count - 1 do
|
|
begin
|
|
sVersionInfoString += fDescriptionStringList[iCount] + LineEnding;
|
|
end
|
|
else
|
|
// User has not set the Description property
|
|
sVersionInfoString += 'No Description';
|
|
end
|
|
else
|
|
sVersionInfoString += LineEnding + fVersionInfoString;
|
|
|
|
if fLicenseTypeString <> '' then
|
|
sVersionInfoString += LineEnding + LineEnding + 'Released under ' +
|
|
fLicenseTypeString;
|
|
lbl_VersionInfo.Caption := sVersionInfoString;
|
|
if fFormType = fSplash then
|
|
lbl_VersionInfo.Top :=
|
|
Bevel.Top + (bevel.Height div 2) - 50
|
|
else
|
|
lbl_VersionInfo.Top := 40;
|
|
lbl_VersionInfo.Parent := fSplashForm;
|
|
lbl_VersionInfo.onClick := @CloseForm;
|
|
|
|
NOTEXT:
|
|
|
|
// Now show the completed form
|
|
Application.ProcessMessages;
|
|
ShowModal;
|
|
end;
|
|
finally
|
|
// Controls normally destroyed with parent
|
|
// but if Try block fails, ensure no memory leaks
|
|
FreeAndNil(bevel);
|
|
FreeAndNil(img_icon);
|
|
FreeAndNil(img_background);
|
|
FreeAndNil(lbl_Title);
|
|
FreeAndNil(lbl_VersionInfo);
|
|
FreeAndNil(OKButton);
|
|
FreeAndNil(LicenseButton);
|
|
FreeAndNil(CreditsButton);
|
|
FreeAndNil(delaytimer);
|
|
FreeAndNil(Scrolltimer);
|
|
FreeAndNil(MyBitMap);
|
|
FreeAndNil(fSplashForm);
|
|
end;
|
|
end;
|
|
// Various Set property routines
|
|
// Note that the object properties are Assigned to
|
|
procedure TSplashAbout.SetBackGroundBitmap(const AValue: TBitmap);
|
|
begin
|
|
fBackGroundBitmap.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSplashAbout.SetMaskMonoBitmap(const AValue: TBitmap);
|
|
begin
|
|
fMaskMonoBitmap.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSplashAbout.SetMaskColorBitmap(const AValue: TBitmap);
|
|
begin
|
|
fMaskColorBitmap.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSplashAbout.SetStrings(const AValue: TStrings);
|
|
begin
|
|
fDescriptionStringList.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSplashAbout.SetFont(const AValue: TFont);
|
|
begin
|
|
fFont.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSplashAbout.SetCreditLines(const AValue: TStrings);
|
|
begin
|
|
fCreditlines.Assign(AValue);
|
|
end;
|
|
|
|
initialization
|
|
// Load license text and masks as lazarus resources
|
|
{$I license.lrs}
|
|
{$I masks.lrs}
|
|
{$Hint Don't worry about the 'Warning: Symbol xxx is not portable' messages}
|
|
{$Hint The 'not portable' code is stuff that won't work outside of Windows}
|
|
{$Hint ..so I flagged it as such in the component code}
|
|
|
|
end.
|