unit ZeroLinkLabelUnit;
interface
uses Stdctrls,Classes,Controls,Forms,Windows,Graphics,ShellAPI,Messages;
type
TZeroLinkLabel=class(TLabel)
private
fUrl: string;
procedure LinkTo;
procedure ZeroMouseLeave(var Msg:TMessage);message CM_MOUSELEAVE;
procedure ZeroMouseEnter(var Msg:TMessage);message CM_MOUSEENTER;
procedure SetUrl(const Value: string);
protected
procedure Click;override;
published
property Url:string read fUrl write SetUrl;
public
constructor Create(AOwner: TComponent);override;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TZeroLinkLabel]);
end;
{ TZeroLinkLabel }
procedure TZeroLinkLabel.Click;
begin
if not (csDesigning in ComponentState)and (fUrl <>'') then LinkTo;
inherited Click;
end;
constructor TZeroLinkLabel.Create(AOwner: TComponent);
begin
inherited;
//set default font
Font.Color:=clBlue;
//set default cursor
Cursor:=crHandPoint;
end;
procedure TZeroLinkLabel.LinkTo;
begin
ShellExecute(Application.handle,'open',pchar(fUrl),nil,nil,SW_SHOWNORMAL);
end;
procedure TZeroLinkLabel.SetUrl(const Value: string);
begin
fUrl:=Value;
end;
procedure TZeroLinkLabel.ZeroMouseEnter(var Msg: TMessage);
begin
Font.Style:=Font.Style+[fsUnderLine];
end;
procedure TZeroLinkLabel.ZeroMouseLeave(var Msg: TMessage);
begin
Font.Style:=Font.Style-[fsUnderLine];
end;
end.
