| 0,0 → 1,57 |
|---|
| // akTimeLog v3.0 |
| // Copyright (c) 1999-2000 Anatoli Klassen |
| unit AboutUnit; |
| |
| interface |
| |
| uses |
| WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls, |
| Buttons, ExtCtrls, ShellAPI; |
| |
| type |
| TAboutBox = class(TForm) |
| OkButton : TBitBtn; |
| ProgramIcon : TImage; |
| ProductName : TLabel; |
| Version : TLabel; |
| Copyright : TLabel; |
| WebLabel: TLabel; |
| MailLabel: TLabel; |
| HTMLLabel: TLabel; |
| MailtoLabel: TLabel; |
| procedure HTMLLabelClick(Sender: TObject); |
| procedure MailtoLabelClick(Sender: TObject); |
| private |
| public |
| end; |
| |
| var |
| AboutBox : TAboutBox; |
| |
| implementation |
| |
| uses SysUtils; |
| |
| {$R *.DFM} |
| |
| procedure TAboutBox.HTMLLabelClick(Sender: TObject); |
| var |
| URL : string; |
| |
| begin |
| if (Sender is TLabel) then begin |
| URL := (Sender as TLabel).Caption; |
| if UpperCase(Copy(URL, 1, 7)) <> 'HTTP://' then URL := 'http://' + URL; |
| |
| ShellExecute(0, nil, PChar(URL), nil, nil, 0); |
| end; |
| end; |
| |
| procedure TAboutBox.MailtoLabelClick(Sender: TObject); |
| begin |
| ShellExecute(0, nil, PChar('mailto:' + MailtoLabel.Caption), nil, nil, 0); |
| end; |
| |
| end. |
| |
| |