421 lines
12 KiB
Plaintext
421 lines
12 KiB
Plaintext
unit IdAboutVCL;
|
|
|
|
interface
|
|
|
|
{$I IdCompilerDefines.inc}
|
|
|
|
uses
|
|
{$IFDEF WIDGET_KYLIX}
|
|
QStdCtrls, QForms, QExtCtrls, QControls, QComCtrls, QGraphics, Qt,
|
|
{$ENDIF}
|
|
{$IFDEF WIDGET_VCL_LIKE}
|
|
StdCtrls, Buttons, ExtCtrls, Graphics, Controls, ComCtrls, Forms,
|
|
{$ENDIF}
|
|
{$IFDEF HAS_UNIT_Types}
|
|
Types,
|
|
{$ENDIF}
|
|
{$IFDEF WIDGET_LCL}
|
|
LResources,
|
|
{$ENDIF}
|
|
Classes, SysUtils;
|
|
|
|
type
|
|
TfrmAbout = class(TForm)
|
|
protected
|
|
FimLogo : TImage;
|
|
FlblCopyRight : TLabel;
|
|
FlblName : TLabel;
|
|
FlblName2 : TLabel;
|
|
FlblVersion : TLabel;
|
|
FlblBuiltFor : TLabel;
|
|
FlblLicense : TLabel;
|
|
FlblPleaseVisitUs : TLabel;
|
|
FlblURL : TLabel;
|
|
//for LCL, we use a TBitBtn to be consistant with some GUI interfaces
|
|
//and the Lazarus IDE.
|
|
{$IFDEF USE_TBitBtn}
|
|
FbbtnOk : TBitBtn;
|
|
{$ELSE}
|
|
FbbtnOk : TButton;
|
|
{$ENDIF}
|
|
procedure lblURLClick(Sender: TObject);
|
|
function GetProductName: String;
|
|
procedure SetProductName(const AValue: String);
|
|
function GetProductName2: String;
|
|
procedure SetProductName2(const AValue: String);
|
|
function GetVersion: String;
|
|
procedure SetVersion(const AValue: String);
|
|
public
|
|
//we have a method for providing a product name and version in case
|
|
//we ever want to make another product.
|
|
class procedure ShowDlg;
|
|
class procedure ShowAboutBox(const AProductName, AProductName2, AProductVersion: String);
|
|
constructor Create(AOwner : TComponent); overload; override;
|
|
constructor Create; reintroduce; overload;
|
|
property ProductName : String read GetProductName write SetProductName;
|
|
property ProductName2 : String read GetProductName2 write SetProductName2;
|
|
property Version : String read GetVersion write SetVersion;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$IFNDEF WIDGET_LCL}
|
|
{$IFDEF WIN32_OR_WIN64}
|
|
{$R IdAboutVCL.RES}
|
|
{$ENDIF}
|
|
{$IFDEF KYLIX}
|
|
{$R IdAboutVCL.RES}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
{$IFDEF WIN32_OR_WIN64}ShellApi, {$ENDIF}
|
|
{$IFNDEF WIDGET_LCL}
|
|
//done this way because we reference HInstance in Delphi for loading
|
|
//resources. Lazarus does something different.
|
|
{$IFDEF WIN32_OR_WIN64}
|
|
Windows,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
IdDsnCoreResourceStrings,
|
|
IdGlobal;
|
|
|
|
{$IFNDEF WIDGET_LCL}
|
|
function RGBToColor(R, G, B: Byte): TColor;
|
|
begin
|
|
Result := RGB(R, G, B);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TfrmAbout }
|
|
|
|
constructor TfrmAbout.Create(AOwner: TComponent);
|
|
begin
|
|
inherited CreateNew(AOwner,0);
|
|
|
|
FimLogo := TImage.Create(Self);
|
|
FlblCopyRight := TLabel.Create(Self);
|
|
FlblName := TLabel.Create(Self);
|
|
FlblName2 := TLabel.Create(Self);
|
|
FlblVersion := TLabel.Create(Self);
|
|
FlblBuiltFor := TLabel.Create(Self);
|
|
FlblLicense := TLabel.Create(Self);
|
|
FlblPleaseVisitUs := TLabel.Create(Self);
|
|
FlblURL := TLabel.Create(Self);
|
|
{$IFDEF USE_TBitBtn}
|
|
FbbtnOk := TBitBtn.Create(Self);
|
|
{$ELSE}
|
|
FbbtnOk := TButton.Create(Self);
|
|
{$ENDIF}
|
|
|
|
Name := 'formAbout';
|
|
Left := 0;
|
|
Top := 0;
|
|
Anchors := [];//[akLeft, akTop, akRight,akBottom];
|
|
BorderIcons := [biSystemMenu];
|
|
BorderStyle := bsDialog;
|
|
|
|
Caption := RSAAboutFormCaption;
|
|
ClientHeight := 336;
|
|
ClientWidth := 554;
|
|
Color := 2520226; // RGBToColor(38, 116, 162)
|
|
|
|
Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
Font.Height := -12;
|
|
Font.Size := 9;
|
|
Font.Name := 'Arial';
|
|
Font.Style := [];
|
|
Position := poScreenCenter;
|
|
{$IFDEF WIDGET_VCL}
|
|
Scaled := True;
|
|
{$ENDIF}
|
|
Constraints.MinHeight := Height;
|
|
Constraints.MinWidth := Width;
|
|
// PixelsPerInch := 96;
|
|
|
|
FimLogo.Name := 'imLogo';
|
|
FimLogo.Parent := Self;
|
|
FimLogo.Left := 0;
|
|
FimLogo.Top := 0;
|
|
FimLogo.Width := 388;
|
|
FimLogo.Height := 240;
|
|
|
|
{$IFDEF WIDGET_LCL}
|
|
FimLogo.Picture.Pixmap.LoadFromLazarusResource('IndyAboutBkgnd'); //this is XPM format, so Pixmap is used
|
|
FimLogo.Align := alClient;
|
|
FimLogo.Stretch := True;
|
|
{$ELSE} // Because Lazarus is also WIDGET_VCL_LIKE_OR_KYLIX
|
|
{$IFDEF WIDGET_VCL_LIKE_OR_KYLIX}
|
|
FimLogo.Picture.Bitmap.LoadFromResourceName(HInstance, 'INDY_ABOUT_BACKGROUND'); {Do not Localize}
|
|
FimLogo.Align := alClient;
|
|
FimLogo.Stretch := True;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
FlblName.Name := 'lblName';
|
|
FlblName.Parent := Self;
|
|
FlblName.Left := 51;
|
|
FlblName.Top := 28;
|
|
FlblName.Width := 200;
|
|
FlblName.Height := 101;
|
|
FlblName.Anchors := [akLeft, akTop];
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblName.Font.Charset := DEFAULT_CHARSET;
|
|
FlblName.Transparent := True;
|
|
{$ENDIF}
|
|
FlblName.Font.Color := clWhite;
|
|
FlblName.Font.Height := -72;
|
|
FlblName.Font.Name := 'Arial Black';
|
|
FlblName.Font.Style := [];
|
|
FlblName.ParentFont := False;
|
|
FlblName.WordWrap := False;
|
|
FlblName.Caption := RSAAboutBoxTitle1;
|
|
|
|
FlblName2.Name := 'lblName2';
|
|
FlblName2.Parent := Self;
|
|
FlblName2.Left := 54;
|
|
FlblName2.Top := 110;
|
|
FlblName2.Width := 192;
|
|
FlblName2.Height := 35;
|
|
FlblName2.Anchors := [akLeft, akTop];
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblName2.Font.Charset := DEFAULT_CHARSET;
|
|
FlblName2.Transparent := True;
|
|
{$ENDIF}
|
|
FlblName2.Font.Color := clWhite;
|
|
FlblName2.Font.Height := -31;
|
|
FlblName2.Font.Name := 'Arial';
|
|
FlblName2.Font.Style := [];
|
|
FlblName2.ParentFont := False;
|
|
FlblName2.WordWrap := False;
|
|
FlblName2.Caption := RSAAboutBoxTitle2;
|
|
|
|
FlblVersion.Name := 'lblVersion';
|
|
FlblVersion.Parent := Self;
|
|
FlblVersion.Left := 300;
|
|
FlblVersion.Top := 170;
|
|
FlblVersion.Width := 200;
|
|
FlblVersion.Height := 17;
|
|
FlblVersion.Alignment := taRightJustify;
|
|
FlblVersion.AutoSize := False;
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblVersion.Font.Charset := DEFAULT_CHARSET;
|
|
FlblVersion.Transparent := True;
|
|
{$ENDIF}
|
|
FlblVersion.Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
FlblVersion.Font.Height := -15;
|
|
FlblVersion.Font.Name := 'Arial';
|
|
FlblVersion.Font.Style := [fsBold];
|
|
FlblVersion.ParentFont := False;
|
|
FlblVersion.Anchors := [akTop, akRight];
|
|
|
|
FlblBuiltFor.Name := 'lblBuiltFor';
|
|
FlblBuiltFor.Parent := Self;
|
|
FlblBuiltFor.Left := 300;
|
|
FlblBuiltFor.Top := 188;
|
|
FlblBuiltFor.Width := 200;
|
|
FlblBuiltFor.Height := 17;
|
|
FlblBuiltFor.Alignment := taRightJustify;
|
|
FlblBuiltFor.AutoSize := False;
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblBuiltFor.Font.Charset := DEFAULT_CHARSET;
|
|
FlblBuiltFor.Transparent := True;
|
|
{$ENDIF}
|
|
FlblBuiltFor.Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
FlblBuiltFor.Font.Height := -14;
|
|
FlblBuiltFor.Font.Name := 'Arial';
|
|
FlblBuiltFor.Font.Style := [];
|
|
FlblBuiltFor.ParentFont := False;
|
|
FlblBuiltFor.Anchors := [akTop, akRight];
|
|
|
|
// RLebeau: not using resouce strings for the product names because:
|
|
// 1. the names are pretty specific and not likely to change with localization;
|
|
// 2. we are trying to avoid using IFDEFs in resource units, per Embarcadero's request;
|
|
// 3. I don't want to create more product-specific resource units unless we really need them;
|
|
{$IFDEF WIDGET_KYLIX}
|
|
FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['Kylix']);
|
|
{$ELSE}
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['VCL']);
|
|
{$ELSE}
|
|
{$IFDEF WIDGET_LCL}
|
|
FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['Lazarus']);
|
|
{$ELSE}
|
|
FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['Unknown']);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
FlblLicense.Name := 'lblLicense';
|
|
FlblLicense.Parent := Self;
|
|
FlblLicense.Left := 300;
|
|
FlblLicense.Top := 227;
|
|
FlblLicense.Width := 200;
|
|
FlblLicense.Height := 45;
|
|
FlblLicense.Alignment := taRightJustify;
|
|
FlblLicense.AutoSize := False;
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblLicense.Font.Charset := DEFAULT_CHARSET;
|
|
FlblLicense.Transparent := True;
|
|
{$ENDIF}
|
|
FlblLicense.Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
FlblLicense.Font.Height := -12;
|
|
FlblLicense.Font.Name := 'Arial';
|
|
FlblLicense.Font.Style := [];
|
|
FlblLicense.ParentFont := False;
|
|
FlblLicense.WordWrap := True;
|
|
FlblLicense.Anchors := [akTop, akRight];
|
|
FlblLicense.Caption := RSAAboutBoxLicences;
|
|
|
|
FlblCopyRight.Name := 'lblCopyRight';
|
|
FlblCopyRight.Parent := Self;
|
|
FlblCopyRight.Left := 58;
|
|
FlblCopyRight.Top := 171;
|
|
FlblCopyRight.Width := 138;
|
|
FlblCopyRight.Height := 15;
|
|
FlblCopyRight.Caption := RSAAboutBoxCopyright;
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblCopyRight.Font.Charset := DEFAULT_CHARSET;
|
|
FlblCopyRight.Transparent := True;
|
|
{$ENDIF}
|
|
FlblCopyRight.Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
FlblCopyRight.Font.Height := -12;
|
|
FlblCopyRight.Font.Name := 'Arial';
|
|
FlblCopyRight.Font.Style := [];
|
|
FlblCopyRight.ParentFont := False;
|
|
FlblCopyRight.WordWrap := True;
|
|
|
|
FlblPleaseVisitUs.Name := 'lblPleaseVisitUs';
|
|
FlblPleaseVisitUs.Parent := Self;
|
|
FlblPleaseVisitUs.Left := 58;
|
|
FlblPleaseVisitUs.Top := 278;
|
|
FlblPleaseVisitUs.Width := 276;
|
|
FlblPleaseVisitUs.Height := 15;
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblPleaseVisitUs.Font.Charset := DEFAULT_CHARSET;
|
|
FlblPleaseVisitUs.Transparent := True;
|
|
{$ENDIF}
|
|
FlblPleaseVisitUs.Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
FlblPleaseVisitUs.Font.Height := -12;
|
|
FlblPleaseVisitUs.Font.Name := 'Arial';
|
|
FlblPleaseVisitUs.ParentFont := False;
|
|
FlblPleaseVisitUs.Caption := RSAAboutBoxPleaseVisit;
|
|
FlblPleaseVisitUs.Anchors := [akLeft, akTop];
|
|
|
|
FlblURL.Name := 'lblURL';
|
|
FlblURL.Left := 58;
|
|
FlblURL.Top := 292;
|
|
FlblURL.Width := 141;
|
|
FlblURL.Height := 15;
|
|
FlblURL.Cursor := crHandPoint;
|
|
{$IFDEF WIDGET_VCL}
|
|
FlblURL.Font.Charset := DEFAULT_CHARSET;
|
|
FlblURL.Transparent := True;
|
|
{$ENDIF}
|
|
FlblURL.Font.Color := 16776138; // RGBToColor(202, 251, 255)
|
|
FlblURL.Font.Height := -12;
|
|
FlblURL.Font.Name := 'Arial';
|
|
FlblURL.ParentFont := False;
|
|
FlblURL.OnClick := lblURLClick;
|
|
FlblURL.Caption := RSAAboutBoxIndyWebsite;
|
|
FlblURL.Anchors := [akLeft, akTop];
|
|
FlblURL.Parent := Self;
|
|
|
|
FbbtnOk.Name := 'bbtnOk';
|
|
FbbtnOk.Left := 475;
|
|
{$IFDEF USE_TBitBtn}
|
|
FbbtnOk.Top := 297;
|
|
{$ELSE}
|
|
FbbtnOk.Top := 302;
|
|
FbbtnOk.Height := 25;
|
|
{$ENDIF}
|
|
FbbtnOk.Width := 75;
|
|
FbbtnOk.Anchors := [akRight, akBottom];
|
|
{$IFDEF USE_TBitBtn}
|
|
FbbtnOk.Font.Color := clBlack;
|
|
FbbtnOk.ParentFont := False;
|
|
FbbtnOk.Kind := bkOk;
|
|
{$ELSE}
|
|
FbbtnOk.Caption := RSOk;
|
|
{$ENDIF}
|
|
FbbtnOk.Cancel := True;
|
|
FbbtnOk.Default := True;
|
|
FbbtnOk.ModalResult := 1;
|
|
FbbtnOk.TabOrder := 0;
|
|
FbbtnOk.Anchors := [akLeft, akTop, akRight];
|
|
FbbtnOk.Parent := Self;
|
|
end;
|
|
|
|
function TfrmAbout.GetVersion: String;
|
|
begin
|
|
Result := FlblVersion.Caption;
|
|
end;
|
|
|
|
function TfrmAbout.GetProductName: String;
|
|
begin
|
|
Result := FlblName.Caption;
|
|
end;
|
|
|
|
function TfrmAbout.GetProductName2: String;
|
|
begin
|
|
Result := FlblName2.Caption;
|
|
end;
|
|
|
|
procedure TfrmAbout.lblURLClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF WIN32_OR_WIN64}
|
|
ShellAPI.ShellExecute(Handle, nil, PChar(FlblURL.Caption), nil, nil, 0); {Do not Localize}
|
|
FlblURL.Font.Color := clPurple;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrmAbout.SetVersion(const AValue: String);
|
|
begin
|
|
FlblVersion.Caption := AValue;
|
|
end;
|
|
|
|
procedure TfrmAbout.SetProductName(const AValue: String);
|
|
begin
|
|
FlblName.Caption := AValue;
|
|
end;
|
|
|
|
procedure TfrmAbout.SetProductName2(const AValue: String);
|
|
begin
|
|
FlblName2.Caption := AValue;
|
|
end;
|
|
|
|
class procedure TfrmAbout.ShowAboutBox(const AProductName, AProductName2, AProductVersion: String);
|
|
var
|
|
LFrm: TfrmAbout;
|
|
begin
|
|
LFrm := TfrmAbout.Create;
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|
try
|
|
{$ENDIF}
|
|
LFrm.Version := IndyFormat(RSAAboutBoxVersion, [AProductVersion]);
|
|
LFrm.ProductName := AProductName;
|
|
LFrm.ProductName2 := AProductName2;
|
|
LFrm.ShowModal;
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|
finally
|
|
LFrm.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
class procedure TfrmAbout.ShowDlg;
|
|
begin
|
|
ShowAboutBox(RSAAboutBoxTitle1, RSAAboutBoxTitle2, gsIdVersion);
|
|
end;
|
|
|
|
constructor TfrmAbout.Create;
|
|
begin
|
|
Create(nil);
|
|
end;
|
|
|
|
{$IFDEF WIDGET_LCL}
|
|
initialization
|
|
{$i IdAboutVCL.lrs}
|
|
{$ENDIF}
|
|
end.
|