You've already forked lazarus-ccr
First commit
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3184 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
621
components/aboutcomponent/aboutcomponentunit.pas
Normal file
621
components/aboutcomponent/aboutcomponentunit.pas
Normal file
@ -0,0 +1,621 @@
|
|||||||
|
{ TAboutComponent and TAboutBox Component License
|
||||||
|
|
||||||
|
Copyright (C) 2014 Gordon Bamber minesadorada@charcodelvalle.com
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or modify it
|
||||||
|
under the terms of the GNU Library General Public License as published by
|
||||||
|
the Free Software Foundation; either version 2 of the License, or (at your
|
||||||
|
option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
||||||
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||||
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
||||||
|
for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Library General Public License
|
||||||
|
along with this library; if not, write to the Free Software Foundation,
|
||||||
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||||
|
}
|
||||||
|
|
||||||
|
// Change the name of this unit and its PAS file to be unique to your component
|
||||||
|
// Unit About<yourcomponentname>unit
|
||||||
|
unit AboutComponentunit;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, Controls, Dialogs, Forms, Graphics, LResources, SysUtils,
|
||||||
|
ExtCtrls, StdCtrls, StrUtils,Buttons,PropEdits;
|
||||||
|
const
|
||||||
|
C_DEFAULTLICENSEFORMWIDTH = 500;
|
||||||
|
C_DEFAULTLICENSEFORMWIDTH_LINUX = C_DEFAULTLICENSEFORMWIDTH + 100;
|
||||||
|
C_DEFAULTLICENSEFORMHEIGHT = 400;
|
||||||
|
C_DEFAULTLICENSEFORMHEIGHT_LINUX = C_DEFAULTLICENSEFORMHEIGHT + 50;
|
||||||
|
|
||||||
|
type
|
||||||
|
TLicenseType = (abNone, abGPL, abLGPL, abMIT, abModifiedGPL, abProprietry);
|
||||||
|
|
||||||
|
// Do Search/Replace to change all instances of TAboutComonent
|
||||||
|
// to TAbout<yourcomponentname>
|
||||||
|
TAboutComponent = class(TComponent)
|
||||||
|
// This class can descend from any component class (TGraphicControl etc
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
fAboutBox: tAboutBox;
|
||||||
|
procedure SetMyComponentName(Const Avalue:String);
|
||||||
|
procedure SetAboutBoxWidth(Const AValue:Integer);
|
||||||
|
procedure SetAboutBoxHeight(Const AValue:Integer);
|
||||||
|
procedure SetAboutBoxDescription(Const AValue:String);
|
||||||
|
procedure SetAboutBoxFontName(Const AValue:String);
|
||||||
|
procedure SetAboutBoxFontSize(Const AValue:Integer);
|
||||||
|
procedure SetAboutBoxBitmap(Const AValue:TBitmap);
|
||||||
|
procedure SetAboutBoxBackgroundColor(Const AValue:TColor);
|
||||||
|
procedure SetAboutBoxTitle(Const AValue:String);
|
||||||
|
|
||||||
|
procedure SetAboutBoxVersion(Const AValue:String);
|
||||||
|
procedure SetAboutBoxAuthorname(Const AValue:String);
|
||||||
|
procedure SetAboutBoxOrganisation(Const AValue:String);
|
||||||
|
procedure SetAboutBoxAuthorEmail(Const AValue:String);
|
||||||
|
procedure SetAboutBoxBackgroundResourceName(Const AValue:String);
|
||||||
|
procedure SetAboutBoxLicenseType(Const AValue:String);
|
||||||
|
procedure SetAboutBoxStretchBackgroundImage(Const AValue:Boolean);
|
||||||
|
protected
|
||||||
|
{ Protected declarations }
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
constructor Create(AOwner: TComponent); override; // Constructor must be public
|
||||||
|
destructor Destroy; override; // Destructor must be public
|
||||||
|
|
||||||
|
// Set these (hidden) properties in your inherited component's Create procedure
|
||||||
|
property AboutBoxComponentName:String write SetMyComponentName;
|
||||||
|
property AboutBoxWidth:Integer write SetAboutBoxWidth;
|
||||||
|
property AboutBoxHeight:Integer write SetAboutBoxHeight;
|
||||||
|
property AboutBoxDescription:String write SetAboutBoxDescription;
|
||||||
|
property AboutBoxFontName:String write SetAboutBoxFontName;
|
||||||
|
property AboutBoxFontSize:Integer write SetAboutBoxFontSize;
|
||||||
|
property AboutBoxBackgroundColor:TColor write SetAboutBoxBackgroundColor;
|
||||||
|
property AboutBoxTitle:String write SetAboutBoxTitle;
|
||||||
|
|
||||||
|
property AboutBoxVersion:String write SetAboutBoxVersion;
|
||||||
|
property AboutBoxAuthorname:String write SetAboutBoxAuthorname;
|
||||||
|
property AboutBoxOrganisation:String write SetAboutBoxOrganisation;
|
||||||
|
property AboutBoxAuthorEmail:String write SetAboutBoxAuthorEmail;
|
||||||
|
property AboutBoxLicenseType:String write SetAboutBoxLicenseType;
|
||||||
|
property AboutBoxBackgroundResourceName:String write SetAboutBoxBackgroundResourceName;
|
||||||
|
property AboutBoxStretchBackgroundImage:Boolean write SetAboutBoxStretchBackgroundImage;
|
||||||
|
published
|
||||||
|
// The clickable 'About' property will automaticcally appear in any component
|
||||||
|
// descended from TAboutComponent
|
||||||
|
|
||||||
|
// About this component...
|
||||||
|
property About: tAboutBox read fAboutBox write fAboutBox;
|
||||||
|
end;
|
||||||
|
TAboutbox = class(TComponent)
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
fDialog: TForm;
|
||||||
|
fBackgroundbitmap: TBitMap;
|
||||||
|
fBackgroundResourceName:String;
|
||||||
|
fDescription: TStrings;
|
||||||
|
fDialogTitle, fVersion, fAuthorname, fAuthorEmail, fOrganisation,
|
||||||
|
fComponentName: string;
|
||||||
|
fDialogHeight, fDialogWidth: integer;
|
||||||
|
fStretchBackground: boolean;
|
||||||
|
fFont: TFont;
|
||||||
|
fColor: TColor;
|
||||||
|
fLicenseType: TLicenseType;
|
||||||
|
procedure SetBackgroundBitmap(const AValue: TBitMap);
|
||||||
|
procedure SetDescriptionStrings(const AValue: TStrings);
|
||||||
|
procedure SetFont(const AValue: TFont);
|
||||||
|
procedure ShowLicense(Sender: TObject);
|
||||||
|
procedure SetDialogTitle(Const AValue:String);
|
||||||
|
protected
|
||||||
|
{ Protected declarations }
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
procedure ShowDialog;
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
{ Published declarations }
|
||||||
|
// Set these properties in your component Constructor method
|
||||||
|
property BackGround: TBitMap read fBackgroundbitmap write SetBackgroundBitmap;
|
||||||
|
property BackgroundResourceName:String read fBackgroundResourceName write fBackgroundResourceName;
|
||||||
|
property Description: TStrings read fDescription write SetDescriptionStrings;
|
||||||
|
property Title: string read fDialogTitle write SetDialogTitle;
|
||||||
|
property Height: integer read fDialogHeight write fDialogHeight;
|
||||||
|
property Width: integer read fDialogWidth write fDialogWidth;
|
||||||
|
property Font: TFont read fFont write SetFont;
|
||||||
|
property BackGroundColor: TColor read fColor write fColor;
|
||||||
|
property StretchBackground: boolean read fStretchBackground
|
||||||
|
write fStretchBackground default False;
|
||||||
|
property Version: string read fVersion write fVersion;
|
||||||
|
property Authorname: string read fAuthorname write fAuthorname;
|
||||||
|
property Organisation: string read fOrganisation write fOrganisation;
|
||||||
|
property AuthorEmail: string read fAuthorEmail write fAuthorEmail;
|
||||||
|
property ComponentName: string read fComponentName write fComponentName;
|
||||||
|
property LicenseType: TLicenseType read fLicenseType write fLicenseType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Declaration for the 'About' property editor
|
||||||
|
TAboutPropertyEditor = class(TClassPropertyEditor)
|
||||||
|
public
|
||||||
|
procedure Edit; override;
|
||||||
|
function GetAttributes: TPropertyAttributes; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
{For i8n if required}
|
||||||
|
resourcestring
|
||||||
|
rs_Componentname='Component name';
|
||||||
|
rs_About='About';
|
||||||
|
rs_License='License';
|
||||||
|
rs_By='By';
|
||||||
|
rs_For='For';
|
||||||
|
rs_DatafileMissing='Resource datafile license.lrs is missing';
|
||||||
|
rs_LicenseTextError='There is something wrong with the Licence text';
|
||||||
|
rs_AboutBoxError = 'Subcomponent TAboutBox Error';
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TABoutBox}
|
||||||
|
|
||||||
|
constructor TAboutbox.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
fBackgroundbitmap := TBitMap.Create;
|
||||||
|
fDescription := TStringList.Create;
|
||||||
|
fFont := TFont.Create;
|
||||||
|
fColor := clDefault;
|
||||||
|
fLicenseType := abNone;
|
||||||
|
fComponentName:=rs_Componentname;
|
||||||
|
fDialogTitle:=rs_About + ' ' + fComponentName;
|
||||||
|
|
||||||
|
fDialogWidth:=320;
|
||||||
|
fDialogHeight:=280;
|
||||||
|
fVersion:='1.0.0.0';
|
||||||
|
fLicenseType:=abNone;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAboutbox.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(fFont);
|
||||||
|
FreeAndNil(fDescription);
|
||||||
|
FreeAndNil(fBackgroundbitmap);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
procedure TAboutbox.SetDialogTitle(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fDialogTitle:=rs_About + ' ' + Avalue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAboutbox.ShowDialog;
|
||||||
|
var
|
||||||
|
OKbutton, LicenseButton: TBitBtn;
|
||||||
|
lbl_Description: TLabel;
|
||||||
|
img_BackGround: TImage;
|
||||||
|
sz: string;
|
||||||
|
iCount: integer;
|
||||||
|
r:TLResource;
|
||||||
|
begin
|
||||||
|
fDialog := TForm.CreateNew(nil);
|
||||||
|
try //.. finally FreeAndNil everything
|
||||||
|
with fDialog do
|
||||||
|
begin
|
||||||
|
// Set Dialog properties
|
||||||
|
position := poScreenCenter;
|
||||||
|
borderstyle := bsToolWindow;
|
||||||
|
Caption := fDialogTitle;
|
||||||
|
formstyle := fsSystemStayOnTop;
|
||||||
|
color := fColor;
|
||||||
|
font := fFont;
|
||||||
|
if (fDialogHeight > 0) then
|
||||||
|
Height := fDialogHeight
|
||||||
|
else
|
||||||
|
Height := 240;
|
||||||
|
if (fDialogWidth > 0) then
|
||||||
|
Width := fDialogWidth
|
||||||
|
else
|
||||||
|
Width := 320;
|
||||||
|
|
||||||
|
// Create a background image
|
||||||
|
img_BackGround := Timage.Create(fDialog);
|
||||||
|
with img_BackGround do
|
||||||
|
// Set img_BackGround properties
|
||||||
|
begin
|
||||||
|
Align := alClient;
|
||||||
|
Stretch := fStretchBackground;
|
||||||
|
// Bitmap assigned?
|
||||||
|
if Assigned(fBackgroundbitmap) then
|
||||||
|
Picture.Assign(fBackgroundbitmap);
|
||||||
|
// Resource file?
|
||||||
|
r := LazarusResources.Find(fBackgroundResourceName);
|
||||||
|
if r <> nil then
|
||||||
|
img_BackGround.Picture.LoadFromLazarusResource(fBackgroundResourceName);
|
||||||
|
SendToBack;
|
||||||
|
parent := fDialog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Create a BitBtn button
|
||||||
|
okbutton := TBitBtn.Create(fDialog);
|
||||||
|
// Set BitBtn properties
|
||||||
|
with okButton do
|
||||||
|
begin
|
||||||
|
Kind := bkClose;
|
||||||
|
left := (fDialog.Width div 2) - Width div 2;
|
||||||
|
top := fDialog.Height - Height - 10;
|
||||||
|
ParentFont:=False;
|
||||||
|
parent := fDialog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Create a License Button
|
||||||
|
LicenseButton := TBitBtn.Create(fDialog);
|
||||||
|
if (fLicenseType <> abNone) then
|
||||||
|
// Put it on the right
|
||||||
|
begin
|
||||||
|
LicenseButton.Top := OKButton.Top;
|
||||||
|
LicenseButton.Caption := rs_License + '...';
|
||||||
|
LicenseButton.left := Width - LicenseButton.Width - 10;
|
||||||
|
LicenseButton.OnClick := @ShowLicense;
|
||||||
|
LicenseButton.ParentFont:=False;
|
||||||
|
LicenseButton.Parent := fDialog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Create a label control
|
||||||
|
lbl_Description := Tlabel.Create(fDialog);
|
||||||
|
// Set label properties
|
||||||
|
with lbl_Description do
|
||||||
|
begin
|
||||||
|
left := 8;
|
||||||
|
Top := 30;
|
||||||
|
Width := fDialog.Width - 8;
|
||||||
|
Height := fDialog.Height - 30;
|
||||||
|
Autosize := False;
|
||||||
|
ParentFont := True;
|
||||||
|
Alignment := taCenter;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Build up Label text
|
||||||
|
sz := '';
|
||||||
|
// Component name
|
||||||
|
if fComponentName <> '' then
|
||||||
|
sz += fComponentName + LineEnding;
|
||||||
|
// Author name (+Email)
|
||||||
|
if fAuthorname <> '' then
|
||||||
|
sz += rs_By + ': ' + fAuthorname + LineEnding;
|
||||||
|
if fAuthorEmail <> '' then
|
||||||
|
sz += ' (' + fAuthorEmail + ')' + LineEnding
|
||||||
|
else
|
||||||
|
sz += LineEnding;
|
||||||
|
|
||||||
|
sz += LineEnding;
|
||||||
|
|
||||||
|
// Version
|
||||||
|
if fVersion <> '' then
|
||||||
|
sz += 'Version: ' + fVersion + LineEnding;
|
||||||
|
// License
|
||||||
|
case fLicenseType of
|
||||||
|
abGPL: sz += rs_License + ': GPL' + LineEnding;
|
||||||
|
abLGPL: sz += rs_License + ': LGPL' + LineEnding;
|
||||||
|
abMIT: sz += rs_License + ': M.I.T.' + LineEnding;
|
||||||
|
abModifiedGPL: sz += rs_License + ': Modified GPL' + LineEnding;
|
||||||
|
abProprietry: sz += rs_License + ': Proprietry' + LineEnding;
|
||||||
|
end;
|
||||||
|
if fOrganisation <> '' then
|
||||||
|
sz += rs_For + ': ' + fOrganisation + LineEnding;
|
||||||
|
if fDescription.Count > 0 then
|
||||||
|
begin
|
||||||
|
sz += LineEnding;
|
||||||
|
for iCount := 1 to fDescription.Count do
|
||||||
|
sz += fDescription[iCount - 1] + LineEnding;
|
||||||
|
end;
|
||||||
|
|
||||||
|
lbl_Description.Caption := sz;
|
||||||
|
lbl_Description.parent := fDialog;
|
||||||
|
// Display the dialog modally
|
||||||
|
ShowModal;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
// Free all resources
|
||||||
|
FreeAndNil(img_BackGround);
|
||||||
|
FreeAndNil(lbl_Description);
|
||||||
|
FreeAndNil(LicenseButton);
|
||||||
|
FreeAndNil(okbutton);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAboutbox.ShowLicense(Sender: TObject);
|
||||||
|
// Triggered by License button Click
|
||||||
|
var
|
||||||
|
sLicenseString: string;
|
||||||
|
theList: TStringList;
|
||||||
|
f: integer;
|
||||||
|
LicenceForm: TForm;
|
||||||
|
lblText: TLabel;
|
||||||
|
closebuttton: TBitBtn;
|
||||||
|
r: TLResource;
|
||||||
|
szLicenseFile: string;
|
||||||
|
begin
|
||||||
|
// Quit early?
|
||||||
|
if fLicenseType = abNone then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
// Set to resource name in license.lrs
|
||||||
|
case fLicenseType of
|
||||||
|
abNone: szLicenseFile := '';
|
||||||
|
abGPL: szLicenseFile := 'gpl.txt';
|
||||||
|
abLGPL: szLicenseFile := 'lgpl.txt';
|
||||||
|
abMIT: szLicenseFile := 'mit.txt';
|
||||||
|
abModifiedgpl: szLicenseFile := 'modifiedgpl.txt';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// 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 + fComponentName + LineEnding;
|
||||||
|
try
|
||||||
|
try
|
||||||
|
begin
|
||||||
|
// Load license text from resource string
|
||||||
|
r := LazarusResources.Find(szLicenseFile);
|
||||||
|
if r = nil then
|
||||||
|
raise Exception.Create(rs_DatafileMissing);
|
||||||
|
thelist.Add(r.Value);
|
||||||
|
for f := 0 to TheList.Count - 1 do
|
||||||
|
sLicenseString += TheList[f] + LineEnding;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
On e: Exception do
|
||||||
|
MessageDlg(rs_AboutBoxError,
|
||||||
|
rs_LicenseTextError, mtError, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Replace boilerplate text if possible
|
||||||
|
sLicenseString := AnsiReplaceText(sLicenseString, '<year>',
|
||||||
|
{$I %DATE%}
|
||||||
|
);
|
||||||
|
sLicenseString := AnsiReplaceText(sLicenseString, '<name of author>', fAuthorname);
|
||||||
|
sLicenseString := AnsiReplaceText(sLicenseString, '<contact>',
|
||||||
|
'(' + fAuthorEmail + ')');
|
||||||
|
sLicenseString := AnsiReplaceText(sLicenseString, '<copyright holders>',
|
||||||
|
fOrganisation);
|
||||||
|
|
||||||
|
// 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 := fComponentName + ': 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 TAboutbox.SetBackgroundBitmap(const AValue: TBitMap);
|
||||||
|
begin
|
||||||
|
if Assigned(AValue) then
|
||||||
|
fBackgroundbitmap.Assign(AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAboutbox.SetDescriptionStrings(const AValue: TStrings);
|
||||||
|
begin
|
||||||
|
if Assigned(AValue) then
|
||||||
|
fDescription.Assign(Avalue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAboutbox.SetFont(const AValue: TFont);
|
||||||
|
begin
|
||||||
|
if Assigned(AValue) then
|
||||||
|
fFont.Assign(AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAboutComponent }
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterPropertyEditor(TypeInfo(TAboutbox),
|
||||||
|
TAboutComponent, 'About', TAboutPropertyEditor);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAboutPropertyEditor.Edit;
|
||||||
|
// Communicate with the component properties
|
||||||
|
Var
|
||||||
|
AAboutBox:TAboutBox;
|
||||||
|
begin
|
||||||
|
AAboutBox:=TAboutBox(GetObjectValue(TAboutBox));
|
||||||
|
AABoutBox.ShowDialog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAboutPropertyEditor.GetAttributes: TPropertyAttributes;
|
||||||
|
// Show the ellipsis
|
||||||
|
begin
|
||||||
|
Result := [paDialog, paReadOnly];
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Sets for AboutBox dialog properties
|
||||||
|
procedure TAboutComponent.SetMyComponentName(Const Avalue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.ComponentName:=AValue;
|
||||||
|
fAboutBox.Title:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxWidth(Const AValue:Integer);
|
||||||
|
begin
|
||||||
|
fAboutBox.Width:=Avalue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxHeight(Const AValue:Integer);
|
||||||
|
begin
|
||||||
|
fAboutBox.Height:=Avalue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxDescription(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.Description.Clear;
|
||||||
|
fAboutBox.Description.Add(AValue);
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxFontName(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.Font.Name:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxFontSize(Const AValue:Integer);
|
||||||
|
begin
|
||||||
|
if (AValue > 6) then fAboutBox.Font.Size:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxTitle(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.Title:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxBitmap(Const AValue:TBitmap);
|
||||||
|
begin
|
||||||
|
If Assigned(Avalue) then fAboutBox.Assign(AValue);
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxBackgroundColor(Const AValue:TColor);
|
||||||
|
begin
|
||||||
|
fAboutBox.BackGroundColor:=AValue;;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxVersion(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.Version:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxAuthorname(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.Authorname:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxOrganisation(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.Organisation:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxAuthorEmail(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.AuthorEmail:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxBackgroundResourceName(Const AValue:String);
|
||||||
|
begin
|
||||||
|
fAboutBox.BackgroundResourceName:=AValue;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxLicenseType(Const AValue:string);
|
||||||
|
begin
|
||||||
|
Case Upcase(AValue) of
|
||||||
|
'GPL':fAboutBox.LicenseType:=abGPL;
|
||||||
|
'LGPL':fAboutBox.LicenseType:=abLGPL;
|
||||||
|
'MIT':fAboutBox.LicenseType:=abMIT;
|
||||||
|
'MODIFIEDGPL':fAboutBox.LicenseType:=abModifiedGPL;
|
||||||
|
'PROPRIETRY':fAboutBox.LicenseType:=abProprietry;
|
||||||
|
else
|
||||||
|
fAboutBox.LicenseType:=abNone;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
procedure TAboutComponent.SetAboutBoxStretchBackgroundImage(Const AValue:Boolean);
|
||||||
|
begin
|
||||||
|
fAboutBox.StretchBackground:=AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// End Sets
|
||||||
|
|
||||||
|
constructor TAboutComponent.Create(AOwner: TComponent);
|
||||||
|
var
|
||||||
|
TempImage: TPicture;
|
||||||
|
r:TLResource;
|
||||||
|
begin
|
||||||
|
// Inherit default properties
|
||||||
|
inherited Create(AOwner);
|
||||||
|
// Use tAboutBox as a subcomponent
|
||||||
|
fAboutBox := tAboutBox.Create(nil);
|
||||||
|
with fAboutBox do
|
||||||
|
begin
|
||||||
|
SetSubComponent(True); // Tell the IDE to store the modified properties
|
||||||
|
// Default of TAboutComponent values override TAbouBox.Create defaults
|
||||||
|
ComponentName := 'TAboutComponent';
|
||||||
|
Description.Add('This is to demonstrate'); //TStrings
|
||||||
|
Description.Add('the use of TAboutComponent'); //TStrings
|
||||||
|
Description.Add('Set its properties in your Constructor'); //TStrings
|
||||||
|
Width := 320; //Integer
|
||||||
|
Height := 280; //Integer
|
||||||
|
// Set any Font properties or subproperties here
|
||||||
|
// Font.Name := 'Arial';
|
||||||
|
Font.Color := clNavy;
|
||||||
|
Font.Size:=10;
|
||||||
|
// BackGroundColor shows if no BackGround image is set
|
||||||
|
BackGroundColor := clWindow;
|
||||||
|
Version := '1.0.0.0';
|
||||||
|
AuthorName := 'Gordon Bamber';
|
||||||
|
AuthorEmail := 'minesadorada@charcodelvalle.com';
|
||||||
|
Organisation := 'Public Domain';
|
||||||
|
|
||||||
|
//Types available: abNone, abGPL, abLGPL, abMIT, abModifiedGPL, abProprietry
|
||||||
|
LicenseType := abLGPL;
|
||||||
|
|
||||||
|
// BackGround image is optional
|
||||||
|
// It must be in a resouce file in the initialization section
|
||||||
|
|
||||||
|
//== How to set a background image to your About dialog --
|
||||||
|
// The BackGround property is a TBitmap
|
||||||
|
// Use a Temporary TPicture to load a JPG.
|
||||||
|
// NOTE a PNG file will create an error when your component is used in an application!
|
||||||
|
r := LazarusResources.Find(fAboutBox.BackgroundResourceName);
|
||||||
|
if r <> nil then
|
||||||
|
begin
|
||||||
|
TempImage := TPicture.Create;
|
||||||
|
// .lrs file is in the initialization section
|
||||||
|
TempImage.LoadFromLazarusResource(fAboutBox.BackgroundResourceName);
|
||||||
|
BackGround.Assign(TempImage.Bitmap);
|
||||||
|
TempImage.Free;
|
||||||
|
StretchBackground := fAboutBox.StretchBackground; //Boolean
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAboutComponent.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(fAboutBox);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
initialization
|
||||||
|
{$I license.lrs}
|
||||||
|
|
||||||
|
end.
|
72
components/aboutcomponent/license.lrs
Normal file
72
components/aboutcomponent/license.lrs
Normal file
@ -0,0 +1,72 @@
|
|||||||
|
LazarusResources.Add('gpl.txt','TXT',[
|
||||||
|
' Copyright (C) <year> <name of author> <contact>'#13#10#13#10' This source'
|
||||||
|
+' is free software; you can redistribute it and/or modify it under'#13#10' '
|
||||||
|
+'the terms of the GNU General Public License as published by the Free'#13#10
|
||||||
|
+' Software Foundation; either version 2 of the License, or (at your option)'
|
||||||
|
+#13#10' any later version.'#13#10#13#10' This code is distributed in the h'
|
||||||
|
+'ope that it will be useful, but WITHOUT ANY'#13#10' WARRANTY; without even'
|
||||||
|
+' the implied warranty of MERCHANTABILITY or FITNESS'#13#10' FOR A PARTICUL'
|
||||||
|
+'AR PURPOSE. See the GNU General Public License for more'#13#10' details.'
|
||||||
|
+#13#10#13#10' A copy of the GNU General Public License is available on the '
|
||||||
|
+'World Wide Web'#13#10' at <http://www.gnu.org/copyleft/gpl.html>. You can '
|
||||||
|
+'also obtain it by writing'#13#10' to the Free Software Foundation, Inc., 5'
|
||||||
|
+'9 Temple Place - Suite 330, Boston,'#13#10' MA 02111-1307, USA.'
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('lgpl.txt','TXT',[
|
||||||
|
' Copyright (C) <year> <name of author> <contact>'#13#10#13#10' This librar'
|
||||||
|
+'y is free software; you can redistribute it and/or modify it'#13#10' under'
|
||||||
|
+' the terms of the GNU Library General Public License as published by'#13#10
|
||||||
|
+' the Free Software Foundation; either version 2 of the License, or (at you'
|
||||||
|
+'r'#13#10' option) any later version.'#13#10#13#10' This program is distri'
|
||||||
|
+'buted in the hope that it will be useful, but WITHOUT'#13#10' ANY WARRANTY'
|
||||||
|
+'; without even the implied warranty of MERCHANTABILITY or'#13#10' FITNESS '
|
||||||
|
+'FOR A PARTICULAR PURPOSE. See the GNU Library General Public License'#13#10
|
||||||
|
+' for more details.'#13#10#13#10' You should have received a copy of the G'
|
||||||
|
+'NU Library General Public License'#13#10' along with this library; if not,'
|
||||||
|
+' write to the Free Software Foundation,'#13#10' Inc., 59 Temple Place - Su'
|
||||||
|
+'ite 330, Boston, MA 02111-1307, USA.'
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('mit.txt','TXT',[
|
||||||
|
' Copyright (c) <year> <copyright holders>'#13#10#13#10' Permission is here'
|
||||||
|
+'by granted, free of charge, to any person obtaining a copy'#13#10' of this'
|
||||||
|
+' software and associated documentation files (the "Software"), to'#13#10' '
|
||||||
|
+'deal in the Software without restriction, including without limitation the'
|
||||||
|
+#13#10' rights to use, copy, modify, merge, publish, distribute, sublicense'
|
||||||
|
+', and/or'#13#10' sell copies of the Software, and to permit persons to who'
|
||||||
|
+'m the Software is'#13#10' furnished to do so, subject to the following con'
|
||||||
|
+'ditions:'#13#10#13#10' The above copyright notice and this permission noti'
|
||||||
|
+'ce shall be included in'#13#10' all copies or substantial portions of the '
|
||||||
|
+'Software.'#13#10#13#10' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY'
|
||||||
|
+' OF ANY KIND, EXPRESS OR'#13#10' IMPLIED, INCLUDING BUT NOT LIMITED TO THE'
|
||||||
|
+' WARRANTIES OF MERCHANTABILITY,'#13#10' FITNESS FOR A PARTICULAR PURPOSE A'
|
||||||
|
+'ND NONINFRINGEMENT. IN NO EVENT SHALL THE'#13#10' AUTHORS OR COPYRIGHT HOL'
|
||||||
|
+'DERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER'#13#10' LIABILITY, WHETHER '
|
||||||
|
+'IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING'#13#10' FROM, OUT OF '
|
||||||
|
+'OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS'#13#10' IN'
|
||||||
|
+' THE SOFTWARE.'
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('modifiedgpl.txt','TXT',[
|
||||||
|
' Copyright (C) <year> <name of author> <contact>'#13#10#13#10' This librar'
|
||||||
|
+'y is free software; you can redistribute it and/or modify it'#13#10' under'
|
||||||
|
+' the terms of the GNU Library General Public License as published by'#13#10
|
||||||
|
+' the Free Software Foundation; either version 2 of the License, or (at you'
|
||||||
|
+'r'#13#10' option) any later version with the following modification:'#13#10
|
||||||
|
+#13#10' As a special exception, the copyright holders of this library give '
|
||||||
|
+'you'#13#10' permission to link this library with independent modules to pr'
|
||||||
|
+'oduce an'#13#10' executable, regardless of the license terms of these inde'
|
||||||
|
+'pendent modules,and'#13#10' to copy and distribute the resulting executabl'
|
||||||
|
+'e under terms of your choice,'#13#10' provided that you also meet, for eac'
|
||||||
|
+'h linked independent module, the terms'#13#10' and conditions of the licen'
|
||||||
|
+'se of that module. An independent module is a'#13#10' module which is not '
|
||||||
|
+'derived from or based on this library. If you modify'#13#10' this library,'
|
||||||
|
+' you may extend this exception to your version of the library,'#13#10' but'
|
||||||
|
+' you are not obligated to do so. If you do not wish to do so, delete this'
|
||||||
|
+#13#10' exception statement from your version.'#13#10#13#10' This program '
|
||||||
|
+'is distributed in the hope that it will be useful, but WITHOUT'#13#10' ANY'
|
||||||
|
+' WARRANTY; without even the implied warranty of MERCHANTABILITY or'#13#10' '
|
||||||
|
+' FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public Licen'
|
||||||
|
+'se'#13#10' for more details.'#13#10#13#10' You should have received a cop'
|
||||||
|
+'y of the GNU Library General Public License'#13#10' along with this librar'
|
||||||
|
+'y; if not, write to the Free Software Foundation,'#13#10' Inc., 59 Temple '
|
||||||
|
+'Place - Suite 330, Boston, MA 02111-1307, USA.'
|
||||||
|
]);
|
31
components/aboutcomponent/readme.txt
Normal file
31
components/aboutcomponent/readme.txt
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
Adding an About property to your component
|
||||||
|
==================================
|
||||||
|
|
||||||
|
Copy the files aboutcomponentunit.pas and license.lrs to your component directory.
|
||||||
|
|
||||||
|
1 ) Rename aboutcomponentunit.pas to about<yourcomponentname>unit.pas
|
||||||
|
2 ) In the pas file rename the Unit to match (1)
|
||||||
|
3 ) Open the renamed pas file and do Search/Replace to change all instances of "TAboutComponent" to TAbout<yourcomponentname>
|
||||||
|
4 ) In the line TAboutComponent = Class(TComponent), change the ancestor to your component's ancestor (if it's not TComponent)
|
||||||
|
5 ) Add the edited pas file to your component's package
|
||||||
|
6 ) In your component's class declaration, change it's ancestor to TAbout<yourcomponentname> (from step 3)
|
||||||
|
7 ) Compile, install and see the new clickable 'About' property in your component!
|
||||||
|
|
||||||
|
Configuring the About property dialog
|
||||||
|
=============================
|
||||||
|
In your component's Constructor Create() set some, all or none of the following properties:
|
||||||
|
|
||||||
|
AboutBoxComponentName (string)
|
||||||
|
AboutBoxWidth (integer)
|
||||||
|
AboutBoxHeight (integer)
|
||||||
|
AboutBoxDescription (string - can contain LineEndings)
|
||||||
|
AboutBoxBackgroundColor (TColor, like clWhite)
|
||||||
|
AboutBoxFontName (string)
|
||||||
|
AboutBoxFontSize (integer)
|
||||||
|
AboutBoxVersion (string)
|
||||||
|
AboutBoxAuthorname (string)
|
||||||
|
AboutBoxOrganisation (string)
|
||||||
|
AboutBoxAuthorEmail (string)
|
||||||
|
AboutBoxLicenseType (string e.g. 'GPL', ModifiedGPL' etc)
|
||||||
|
|
||||||
|
You will have to recompile and reinstall your component to see the results.
|
Reference in New Issue
Block a user