aboutfrm.pas

MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序； “MiniHex11SrcControls”目录中的是该软件

unit AboutFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  ShellApi;

type
  TAboutForm = class(TForm)
    Label1: TLabel;
    Bevel1: TBevel;
    Image2: TImage;
    Label2: TLabel;
    OkButton: TButton;
    Image3: TImage;
    Image4: TImage;
    EMailPanel: TPanel;
    URLPanel: TPanel;
    Label3: TLabel;
    VertPanel: TPanel;
    Image1: TImage;
    Label4: TLabel;
    procedure OkButtonClick(Sender: TObject);
    procedure EMailPanelClick(Sender: TObject);
    procedure URLPanelClick(Sender: TObject);
    procedure EMailPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure URLPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AboutForm: TAboutForm;

procedure ShowAboutForm;

implementation

{$R *.DFM}

uses
  MainFrm;

procedure ShowAboutForm;
var
  Frm: TAboutForm;
begin
  Frm := TAboutForm.Create(Application);
  Frm.ShowModal;
  Frm.Free;
end;

procedure TAboutForm.OkButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TAboutForm.EMailPanelClick(Sender: TObject);
var
  S: string;
begin
  S := 'About ' + MINIHEX_VERSION_INFO;
  ShellExecute(Handle, 'Open', PChar('mailto:[e-mail]?subject="' + S + '"'), '', '', 1);
end;

procedure TAboutForm.URLPanelClick(Sender: TObject);
begin
  ShellExecute(Self.Handle, 'Open', PChar('http://haoxg.yeah.net'), '', '', 1);
end;

procedure TAboutForm.EMailPanelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if (X >=0) and (X < EMailPanel.Width) and (Y >=0) and (Y < EMailPanel.Height) then
  begin
    EMailPanel.Font.Style := [fsUnderline];
    EMailPanel.Font.Color := clRed;
    SetCapture(EMailPanel.Handle);
  end else
  begin
    EMailPanel.Font.Style := [];
    EMailPanel.Font.Color := clBlue;
    ReleaseCapture;
  end;
end;

procedure TAboutForm.URLPanelMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (X >=0) and (X < URLPanel.Width) and (Y >=0) and (Y < URLPanel.Height) then
  begin
    URLPanel.Font.Style := [fsUnderline];
    URLPanel.Font.Color := clRed;
    SetCapture(URLPanel.Handle);
  end else
  begin
    URLPanel.Font.Style := [];
    URLPanel.Font.Color := clBlue;
    ReleaseCapture;
  end;
end;

end.