unit LinkLabel;

interface

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

type
  TLinkLabel = class(TCustomLabel)
  private
    { Private declarations }
    FAdres :String;
    procedure DodajPodkreslenie(Sender :TObject);
    procedure UsunPodkreslenie(Sender :TObject);
  protected
    { Protected declarations }
    function SprawdzAdres(AAdres :String) :Boolean; virtual; abstract;
    procedure SetAdres(AAdres :String); virtual; abstract;
  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;

  TLink = class(TLinkLabel)
  protected
    function SprawdzAdres(AAdres :String) :Boolean; override;
    procedure SetAdres(AAdres :String); override;
  public
    constructor Create(Owner :TComponent); override;
  end;

  TMail = class(TLinkLabel)
  protected
    function SprawdzAdres(AAdres :String) :Boolean; override;
    procedure SetAdres(AAdres :String); override;
  public
    constructor Create(Owner :TComponent); override;
  end;



procedure Register;

implementation

constructor TLinkLabel.Create(Owner :TComponent);
var LinkStyle :TFontStyles; //zbior
begin
   inherited Create(Owner);
   LinkStyle:=[];
   Font.Color:=clNavy;
   Font.Style:=LinkStyle;
   Cursor:=crHandPoint;
   OnClick:=Polacz;
   OnMouseEnter:=DodajPodkreslenie;
   OnMouseLeave:=UsunPodkreslenie;
end;

procedure TLinkLabel.DodajPodkreslenie(Sender :TObject);
var LinkStyle :TFontStyles; //zbior
begin
Include(LinkStyle,fsUnderline);
Font.Style:=LinkStyle;
end;

procedure TLinkLabel.UsunPodkreslenie(Sender :TObject);
var LinkStyle :TFontStyles; //zbior
begin
Exclude(LinkStyle,fsUnderline);
Font.Style:=LinkStyle;
end;

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

{TLINK}

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

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

constructor TLink.Create(Owner :TComponent);
begin
inherited Create(Owner);
Adres:='http://helion.pl';
end;

{TMAIL}

function TMail.SprawdzAdres(AAdres :String) :Boolean;
begin
Result:=(Copy(AAdres,1,7)='mailto:');
end;

procedure TMail.SetAdres(AAdres :String);
begin
if not SprawdzAdres(AAdres) then AAdres:='mailto:'+AAdres;
FAdres:=AAdres;
end;

constructor TMail.Create(Owner :TComponent);
begin
inherited Create(Owner);
Adres:='mailto:helion@helion.pl';
end;


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

end.
