root / UFAbout.pas @ 3
Historique | Voir | Annoter | Télécharger (3,168 ko)
1 | 3 | avalancogn | 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. |