restemplate/indy/Core/IdAboutVCL.pas

421 lines
12 KiB
Plaintext
Raw Normal View History

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.