其他

开发平台：

Delphi

NWURLLabel.pas：源码内容

							unit NWURLLabel;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI;
type
  TNWURLLabel = class(TLabel)
  private
    { Private declarations }
    FCursor: TCursor;
    FFontColor: TColor;
    FHangColor: TColor;
    FURL: String;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetHangColor(const Value: TColor);
    procedure SetURL(const Value: String);
  protected
    { Protected declarations }
    procedure Click; override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
  published
    { Published declarations }
    property HangColor: TColor read FHangColor write SetHangColor default clBlue;
    property URL: String read FURL write SetURL;
  end;
procedure Register;
implementation
{$R *.DCR}
procedure Register;
begin
  RegisterComponents('NoctWolf', [TNWURLLabel]);
end;
procedure TNWURLLabel.Click;
begin
  ShellExecute(Parent.Handle, nil, PChar(FURL), nil, nil, SW_ShowNormal);
end;
procedure TNWURLLabel.CMMouseEnter(var Message: TMessage);
begin
  if Enabled then
  begin
    FCursor := Cursor;
    FFontColor := Font.Color;
    Cursor := crHandPoint;
    Font.Color := FHangColor;
    Font.Style := Font.Style + [fsUnderline];
  end;
end;
procedure TNWURLLabel.CMMouseLeave(var Message: TMessage);
begin
  Cursor := FCursor;
  Font.Color := FFontColor;
  Font.Style := Font.Style - [fsUnderline];
end;
constructor TNWURLLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := '我的信箱';
  FHangColor := clBlue;
  FURL := 'mailto:noctwolf@990.net';
end;
procedure TNWURLLabel.SetHangColor(const Value: TColor);
begin
  if FHangColor <> Value then FHangColor := Value;
end;
procedure TNWURLLabel.SetURL(const Value: String);
begin
  if FURL <> Value then FURL := Value;
end;
end.

						