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.
|
---|