| 1 | unit UApplicationInfo;
|
|---|
| 2 |
|
|---|
| 3 | {$mode delphi}
|
|---|
| 4 |
|
|---|
| 5 | interface
|
|---|
| 6 |
|
|---|
| 7 | uses
|
|---|
| 8 | SysUtils, Classes, Forms, URegistry, Controls;
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 |
|
|---|
| 12 | { TApplicationInfo }
|
|---|
| 13 |
|
|---|
| 14 | TApplicationInfo = class(TComponent)
|
|---|
| 15 | private
|
|---|
| 16 | FDescription: TCaption;
|
|---|
| 17 | FIdentification: Byte;
|
|---|
| 18 | FLicense: string;
|
|---|
| 19 | FVersionMajor: Byte;
|
|---|
| 20 | FVersionMinor: Byte;
|
|---|
| 21 | FVersionBugFix: Byte;
|
|---|
| 22 | FVersionSuffix: string; // alfa, beta, RC1, RC2, ...
|
|---|
| 23 | FCompanyName: string;
|
|---|
| 24 | FCompanyHomePage: string;
|
|---|
| 25 | FHomePage: string;
|
|---|
| 26 | FAuthorsName: string;
|
|---|
| 27 | FEmailContact: string;
|
|---|
| 28 | FAppName: string;
|
|---|
| 29 | FReleaseDate: TDateTime;
|
|---|
| 30 | FRegistryKey: string;
|
|---|
| 31 | FRegistryRoot: TRegistryRoot;
|
|---|
| 32 | function GetVersion: string;
|
|---|
| 33 | public
|
|---|
| 34 | constructor Create(AOwner: TComponent); 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: string 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 | end;
|
|---|
| 55 |
|
|---|
| 56 | procedure Register;
|
|---|
| 57 |
|
|---|
| 58 | implementation
|
|---|
| 59 |
|
|---|
| 60 | procedure Register;
|
|---|
| 61 | begin
|
|---|
| 62 | RegisterComponents('Common', [TApplicationInfo]);
|
|---|
| 63 | end;
|
|---|
| 64 |
|
|---|
| 65 | { TApplicationInfo }
|
|---|
| 66 |
|
|---|
| 67 | function TApplicationInfo.GetVersion: string;
|
|---|
| 68 | begin
|
|---|
| 69 | Result := IntToStr(FVersionMajor) + '.' + IntToStr(FVersionMinor);
|
|---|
| 70 | if FVersionSuffix <> '' then Result := Result + ' ' + FVersionSuffix
|
|---|
| 71 | else Result := Result + '.' + IntToStr(FVersionBugFix);
|
|---|
| 72 | end;
|
|---|
| 73 |
|
|---|
| 74 | constructor TApplicationInfo.Create(AOwner: TComponent);
|
|---|
| 75 | begin
|
|---|
| 76 | inherited Create(AOwner);
|
|---|
| 77 | FVersionMajor := 1;
|
|---|
| 78 | FIdentification := 1;
|
|---|
| 79 | FAppName := Application.Name;
|
|---|
| 80 | FRegistryKey := '\Software\' + FAppName;
|
|---|
| 81 | FRegistryRoot := rrKeyCurrentUser;
|
|---|
| 82 | end;
|
|---|
| 83 |
|
|---|
| 84 | function TApplicationInfo.GetRegistryContext: TRegistryContext;
|
|---|
| 85 | begin
|
|---|
| 86 | Result := TRegistryContext.Create(RegistryRoot, RegistryKey);
|
|---|
| 87 | end;
|
|---|
| 88 |
|
|---|
| 89 | end.
|
|---|