| 1 | unit ApplicationInfo;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | SysUtils, Classes, Forms, RegistryEx, Controls, Graphics, LCLType;
|
|---|
| 7 |
|
|---|
| 8 | type
|
|---|
| 9 |
|
|---|
| 10 | { TApplicationInfo }
|
|---|
| 11 |
|
|---|
| 12 | TApplicationInfo = class(TComponent)
|
|---|
| 13 | private
|
|---|
| 14 | FDescription: TTranslateString;
|
|---|
| 15 | FIcon: TBitmap;
|
|---|
| 16 | FIdentification: Byte;
|
|---|
| 17 | FLicense: string;
|
|---|
| 18 | FVersionMajor: Byte;
|
|---|
| 19 | FVersionMinor: Byte;
|
|---|
| 20 | FVersionBugFix: Byte;
|
|---|
| 21 | FVersionSuffix: string; // alfa, beta, RC1, RC2, ...
|
|---|
| 22 | FCompanyName: string;
|
|---|
| 23 | FCompanyHomePage: string;
|
|---|
| 24 | FHomePage: string;
|
|---|
| 25 | FAuthorsName: string;
|
|---|
| 26 | FEmailContact: string;
|
|---|
| 27 | FAppName: string;
|
|---|
| 28 | FReleaseDate: TDateTime;
|
|---|
| 29 | FRegistryKey: string;
|
|---|
| 30 | FRegistryRoot: TRegistryRoot;
|
|---|
| 31 | function GetVersion: string;
|
|---|
| 32 | public
|
|---|
| 33 | constructor Create(AOwner: TComponent); override;
|
|---|
| 34 | destructor Destroy; override;
|
|---|
| 35 | property Version: string read GetVersion;
|
|---|
| 36 | function GetRegistryContext: TRegistryContext;
|
|---|
| 37 | published
|
|---|
| 38 | property Identification: Byte read FIdentification write FIdentification;
|
|---|
| 39 | property VersionMajor: Byte read FVersionMajor write FVersionMajor;
|
|---|
| 40 | property VersionMinor: Byte read FVersionMinor write FVersionMinor;
|
|---|
| 41 | property VersionBugFix: Byte read FVersionBugFix write FVersionBugFix;
|
|---|
| 42 | property VersionSuffix: string read FVersionSuffix write FVersionSuffix;
|
|---|
| 43 | property CompanyName: string read FCompanyName write FCompanyName;
|
|---|
| 44 | property CompanyHomePage: string read FCompanyHomePage write FCompanyHomePage;
|
|---|
| 45 | property HomePage: string read FHomePage write FHomePage;
|
|---|
| 46 | property AuthorsName: string read FAuthorsName write FAuthorsName;
|
|---|
| 47 | property EmailContact: string read FEmailContact write FEmailContact;
|
|---|
| 48 | property AppName: string read FAppName write FAppName;
|
|---|
| 49 | property Description: TTranslateString read FDescription write FDescription;
|
|---|
| 50 | property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate;
|
|---|
| 51 | property RegistryKey: string read FRegistryKey write FRegistryKey;
|
|---|
| 52 | property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
|
|---|
| 53 | property License: string read FLicense write FLicense;
|
|---|
| 54 | property Icon: TBitmap read FIcon write FIcon;
|
|---|
| 55 | end;
|
|---|
| 56 |
|
|---|
| 57 | procedure Register;
|
|---|
| 58 |
|
|---|
| 59 |
|
|---|
| 60 | implementation
|
|---|
| 61 |
|
|---|
| 62 | procedure Register;
|
|---|
| 63 | begin
|
|---|
| 64 | RegisterComponents('Common', [TApplicationInfo]);
|
|---|
| 65 | end;
|
|---|
| 66 |
|
|---|
| 67 | { TApplicationInfo }
|
|---|
| 68 |
|
|---|
| 69 | function TApplicationInfo.GetVersion: string;
|
|---|
| 70 | begin
|
|---|
| 71 | Result := IntToStr(FVersionMajor) + '.' + IntToStr(FVersionMinor);
|
|---|
| 72 | if FVersionSuffix <> '' then Result := Result + ' ' + FVersionSuffix
|
|---|
| 73 | else Result := Result + '.' + IntToStr(FVersionBugFix);
|
|---|
| 74 | end;
|
|---|
| 75 |
|
|---|
| 76 | constructor TApplicationInfo.Create(AOwner: TComponent);
|
|---|
| 77 | begin
|
|---|
| 78 | inherited;
|
|---|
| 79 | FVersionMajor := 1;
|
|---|
| 80 | FIdentification := 1;
|
|---|
| 81 | FAppName := Application.Name;
|
|---|
| 82 | FRegistryKey := '\Software\' + FAppName;
|
|---|
| 83 | FRegistryRoot := rrKeyCurrentUser;
|
|---|
| 84 | FIcon := TBitmap.Create;
|
|---|
| 85 | end;
|
|---|
| 86 |
|
|---|
| 87 | destructor TApplicationInfo.Destroy;
|
|---|
| 88 | begin
|
|---|
| 89 | FreeAndNil(FIcon);
|
|---|
| 90 | inherited;
|
|---|
| 91 | end;
|
|---|
| 92 |
|
|---|
| 93 | function TApplicationInfo.GetRegistryContext: TRegistryContext;
|
|---|
| 94 | begin
|
|---|
| 95 | Result := TRegistryContext.Create(RegistryRoot, RegistryKey);
|
|---|
| 96 | end;
|
|---|
| 97 |
|
|---|
| 98 | end.
|
|---|