logof.pas

来自「极具实用价值的文件管理系统」· PAS 代码 · 共 119 行

{ *********************************************************************** }
{ Unit Name: LogoF                                                       
{ Purpose: LogoF
{ Author: Cyclone
{ History:
{         2004-12-12 13:00:20 Create the function
{ *********************************************************************** }


unit LogoF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, CycPanel, ExtCtrls, ShellApi, Pubfuns, jpeg,
  CycSpeedButton, BaseF;

type
  TfmLogo = class(TfmBase)
    pnlTitle: TCycPanel;
    pnlMain: TCycPanel;
    lblSystemName: TLabel;
    Panel1: TPanel;
    lblSystemVersion: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lblWebSite: TLabel;
    lblEmail: TLabel;
    ImgSystem: TImage;
    Label1: TLabel;
    procedure pnlTitleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblWebSiteClick(Sender: TObject);
    procedure lblEmailClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure  MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure  MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
  public
    { Public declarations }
  end;

var
  fmLogo: TfmLogo;

implementation

{$R *.dfm}

procedure TfmLogo.MouseEnter(var Msg: TMessage);
var
  Obj: TObject;
begin
  Obj := TObject(Msg.LParam);
  if Obj = lblWebSite then
  begin
    Screen.Cursor := crHandPoint;
    lblWebSite.Font.Color := clBlue;
    lblWebSite.Font.Style := lblWebSite.Font.Style + [fsUnderline];
  end
  else if Obj = lblEmail then
  begin
    Screen.Cursor := crHandPoint;
    lblEmail.Font.Color := clBlue;
    lblEmail.Font.Style := lblWebSite.Font.Style + [fsUnderline];
  end;
end;

procedure TfmLogo.MouseLeave(var Msg: TMessage);
var
  Obj: TObject;
begin
  Obj := TObject(Msg.LParam);
  if Obj = lblWebSite then
  begin
    Screen.Cursor := crDefault;
    lblWebSite.Font.Color := clWindowText;
    lblWebSite.Font.Style := lblWebSite.Font.Style - [fsUnderline];
  end
  else if Obj = lblEmail then
  begin
    Screen.Cursor := crDefault;
    lblEmail.Font.Color := clWindowText;
    lblEmail.Font.Style := lblWebSite.Font.Style - [fsUnderline];
  end;
end;

procedure TfmLogo.pnlTitleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TfmLogo.lblWebSiteClick(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', Pchar(lblWebSite.Caption), '', '', SW_SHOWNORMAL);
end;

procedure TfmLogo.lblEmailClick(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', Pchar('MailTo:' + lblEmail.Caption), '', '', SW_SHOWNORMAL);
end;

procedure TfmLogo.FormCreate(Sender: TObject);
begin
  pnlTitle.Caption := pSystemName + ' Initializing...';
  lblSystemName.Caption := pSystemName;
  lblSystemVersion.Caption := 'Version ' + pSystemVersion;
  lblWebSite.Caption := pCompanyWebSite;
  lblEmail.Caption := pCompanyEmail;
end;

end.