www.pudn.com > oicqspysrc.zip > 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.