root / UFAbout.pas @ 3
Historique | Voir | Annoter | Télécharger (3,168 ko)
1 |
unit UFAbout;
|
---|---|
2 |
|
3 |
interface
|
4 |
|
5 |
uses
|
6 |
Windows, Messages, Forms, Classes, Controls, StdCtrls, ExtCtrls, Buttons, |
7 |
GIFImg; |
8 |
|
9 |
type
|
10 |
TFAbout = class(TForm)
|
11 |
LProduct: TLabel; |
12 |
LVersion: TLabel; |
13 |
PBoutons: TPanel; |
14 |
BBOk: TBitBtn; |
15 |
MConfig: TMemo; |
16 |
ILogo: TImage; |
17 |
PTitle: TPanel; |
18 |
PContent: TPanel; |
19 |
LIDDN: TLabel; |
20 |
LURL: TLabel; |
21 |
procedure FormShow(Sender: TObject);
|
22 |
procedure FormCreate(Sender: TObject);
|
23 |
procedure LURLClick(Sender: TObject);
|
24 |
procedure LURLMouseEnter(Sender: TObject);
|
25 |
procedure LURLMouseLeave(Sender: TObject);
|
26 |
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; |
27 |
private
|
28 |
{ Private declarations }
|
29 |
public
|
30 |
{ Public declarations }
|
31 |
end;
|
32 |
|
33 |
var
|
34 |
FAbout: TFAbout; |
35 |
|
36 |
implementation
|
37 |
|
38 |
uses
|
39 |
ShellAPI, SysUtils, gnugettext, UVariables, UStrings, UUtil; |
40 |
|
41 |
{$R *.dfm}
|
42 |
|
43 |
procedure TFAbout.FormCreate(Sender: TObject);
|
44 |
begin
|
45 |
if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1 |
46 |
then
|
47 |
Font.Name := 'Arial Unicode MS';
|
48 |
TranslateComponent(Self); |
49 |
Constraints.MinWidth := 360 + (Width - ClientWidth);
|
50 |
Width := Constraints.MinWidth; |
51 |
Constraints.MinHeight := 320 + (Height - ClientHeight);
|
52 |
Height := Constraints.MinHeight; |
53 |
end;
|
54 |
|
55 |
procedure TFAbout.FormShow(Sender: TObject);
|
56 |
begin
|
57 |
LVersion.Caption := VersionString; |
58 |
case LicenseType of |
59 |
2: // Compl?te |
60 |
begin
|
61 |
MConfig.Lines.Add(Format(StrLicenseType, [StrComplete])); |
62 |
MConfig.Lines.Add(Format(StrLicenseNum, [LicenseNumber])); |
63 |
MConfig.Lines.Add(Format(StrFirstName, [FirstName])); |
64 |
MConfig.Lines.Add(Format(StrLastName, [LastName])); |
65 |
MConfig.Lines.Add(Format(StrCompany, [Company])); |
66 |
MConfig.Lines.Add(Format(StrEndValidity, [FinalDate])); |
67 |
if Length(SoftwareEnableKey) = 0 |
68 |
then // Cl? absente |
69 |
MConfig.Lines.Add(StrNoKey) |
70 |
else
|
71 |
if not IsComplete |
72 |
then // Cl? incorrecte |
73 |
MConfig.Lines.Add(StrInvalidKey); |
74 |
end ;
|
75 |
1: // Education |
76 |
begin
|
77 |
MConfig.Lines.Add(Format(StrLicenseType, [StrEducation])); |
78 |
MConfig.Lines.Add(Format(StrFirstName, [FirstName])); |
79 |
MConfig.Lines.Add(Format(StrLastName, [LastName])); |
80 |
MConfig.Lines.Add(Format(StrOrganization, [Company])); |
81 |
MConfig.Lines.Add(Format(StrEndValidity, [FinalDate])); |
82 |
if Length(SoftwareEnableKey) = 0 |
83 |
then // Cl? absente |
84 |
MConfig.Lines.Add(StrNoKey) |
85 |
else
|
86 |
if not IsEducation |
87 |
then // Cl? incorrecte |
88 |
MConfig.Lines.Add(StrInvalidKey); |
89 |
end ;
|
90 |
else // Evaluation |
91 |
MConfig.Lines.Add(Format(StrLicenseType, [StrEvaluation])); |
92 |
end;
|
93 |
LURL.Caption := URL_HTTPS; |
94 |
end;
|
95 |
|
96 |
procedure TFAbout.LURLMouseEnter(Sender: TObject);
|
97 |
begin
|
98 |
Screen.Cursor := crHandPoint; |
99 |
end;
|
100 |
|
101 |
procedure TFAbout.LURLMouseLeave(Sender: TObject);
|
102 |
begin
|
103 |
Screen.Cursor := crDefault; |
104 |
end;
|
105 |
|
106 |
procedure TFAbout.LURLClick(Sender: TObject);
|
107 |
begin
|
108 |
ShellExecute(Handle, 'open', PChar(URL_HTTPS), nil, nil, SW_SHOWNORMAL); |
109 |
end;
|
110 |
|
111 |
procedure TFAbout.WMSysCommand(var Message: TWMSysCommand); |
112 |
begin
|
113 |
if Message.CmdType = SC_MINIMIZE
|
114 |
then
|
115 |
Application.Minimize |
116 |
else
|
117 |
inherited;
|
118 |
end;
|
119 |
|
120 |
end.
|