unit LinkLabel;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Graphics, Windows, ShellApi;

type
  TLinkLabel = class(TCustomLabel)
  private
    { Private declarations }
    FAdres :String;
  protected
    { Protected declarations }
    function SprawdzAdres(AAdres :String) :Boolean;
    procedure SetAdres(AAdres :String);
  public
    { Public declarations }
    constructor Create(Owner :TComponent); override;
    procedure Polacz(Sender :TObject);
  published
    { Published declarations }
    property Adres :String read FAdres write SetAdres;
    //wlasnosci
    property Caption;
    property Font;
    property AutoSize;
    property Color;
    property PopupMenu;
    //zdarzenia
    property OnDragOver;
    property OnDragDrop;
    property OnEndDrag;
  end;

procedure Register;

implementation

constructor TLinkLabel.Create(Owner :TComponent);
var LinkStyle :TFontStyles; //zbior
begin
   inherited Create(Owner);
   LinkStyle:=[fsUnderline];
   Font.Color:=clNavy;
   Font.Style:=LinkStyle;
   Cursor:=crHandPoint;
   Adres:='http://helion.pl';
   OnClick:=Polacz;
end;

procedure TLinkLabel.SetAdres(AAdres :String);
begin
if not SprawdzAdres(AAdres) then AAdres:='http://'+AAdres;
FAdres:=AAdres;
end;

function TLinkLabel.SprawdzAdres(AAdres :String) :Boolean;
begin
Result:=(Copy(AAdres,1,7)='http://');
end;

procedure TLinkLabel.Polacz(Sender :TObject);
begin
Font.Color:=clBlack;
{$IF NOT DEFINED(CLR)}
ShellExecute(0,'open',PCHar(Adres),'','',SW_NORMAL);
{$ELSE}
ShellExecute(0,'open',Adres,'','',SW_NORMAL);
{$IFEND}
end;

procedure Register;
begin
  RegisterComponents('Helion', [TLinkLabel]);
end;

end.
