unit woLinkLabel;
{
        Webocton - LinkLabel

        Komponente welches ein Label um eine Hyperlink-
        Funktionalität erweitert.

        Die Komponente kümmert sich um Hervorhebung während sich
        die Maus über der Komponente befindet (HoverFont) und öffnet
        bei Bedarf (AutoOpen) automatisch die
        angegebene Internet-Adresse (URL)

        Version vom: 20.04.2004

        Copyright 2004-2008 by Benedikt Loepp
        Webocton

        benedikt@webocton.de
        www.webocton.de

        ---

        Benötigt wird Borland Delphi+Visual Component Library
}

interface

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

type
    TwoLinkLabel = class(TLabel)
    private
        FHoverFont: TFont;
        FTempFont: TFont;
        FUrl: string;
        FAutoOpen: Boolean;
        procedure SetUrl(Value: string);
        procedure SetHoverFont(Value: TFont);
        procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
        procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
        procedure UrlClick(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
        procedure SetAutoOpen(const Value: Boolean);
    public
        constructor Create(AOwner: TComponent); override;
        destructor Free;
    published
        property HoverFont: TFont read FHoverFont write SetHoverFont;
        property AutoOpen: Boolean read FAutoOpen write SetAutoOpen;
        property URL: string read FUrl write SetUrl;
    end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('Webocton - Components', [TwoLinkLabel]);
end;

destructor TwoLinkLabel.Free;
begin
    inherited Free;

    if Assigned(FHoverFont) then
        FreeAndNil(FHoverFont);

    if Assigned(FTempFont) then
        FreeAndNil(FTempFont);
end;

constructor TwoLinkLabel.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    FHoverFont := TFont.Create;
    FTempFont := TFont.Create;

    HoverFont.Style := [fsUnderline];
    HoverFont.Color := clBlue;

    Cursor := crHandPoint;

    URL := 'http://www.webocton.de';

    FAutoOpen := FALSE;
end;

procedure TwoLinkLabel.SetHoverFont(Value: TFont);
begin
    if (Assigned(Value)) then
        fHoverFont := Value;
end;

procedure TwoLinkLabel.UrlClick(var Message: TWMLButtonDown);
var
    Url: PChar;
begin
    if (not (FAutoOpen)) then
        Exit;

    Url := PChar(Self.Url);
    ShellExecute(Parent.Handle, 'open', Url, '', '', SW_SHOWNORMAL);
end;

procedure TwoLinkLabel.SetUrl(Value: string);
begin
    fUrl := Value;
end;

procedure TwoLinkLabel.MouseEnter(var Message: TMessage);
begin
    if not (csDesigning in ComponentState) then
    begin
        inherited;

        fTempFont.Assign(Self.Font);
        Self.Font.Assign(fHoverFont);
    end;
end;

procedure TwoLinkLabel.MouseLeave(var Message: TMessage);
begin
    if not (csDesigning in ComponentState) then
    begin
        inherited;

        Self.Font.Assign(fTempFont);
    end;
end;

procedure TwoLinkLabel.SetAutoOpen(const Value: Boolean);
begin
    FAutoOpen := Value;
end;

end.