unit LLabel; 
 
interface 
 
uses 
  Messages, 
  Classes, 
  Graphics, 
  Controls, 
  StdCtrls; 
 
type 
  TLLabel = class(TLabel) 
  private 
    FNormal, FActive, FClick: TColor; 
    FOnEnter, FOnLeave: TNotifyevent; 
    FClicked, FAsLink, Fwithin, FSwitch, FShowActive: Boolean; 
  protected 
    procedure MEnter(var EMsg: TMessage); message CM_MouseEnter; 
    procedure MLeave(var LMsg: TMessage); message CM_MouseLeave; 
    procedure MUp(var CMsg: TMessage); message WM_LBUTTONUP; 
    procedure setFClicked(b: Boolean); 
    procedure SetFClick(f: TColor); 
    procedure SetFNormal(f: TColor); 
    procedure SetFActive(f: TColor); 
    procedure SetFAsLink(b: Boolean); 
    function SetColor: TColor; 
  public 
    constructor Create(AOwner: TComponent); override; 
  published 
    property OnMouseEnter: TNotifyevent read FOnEnter write FOnEnter; 
    property OnMouseLeave: TNotifyevent read FOnLeave write FOnLeave; 
    property ShowActive: Boolean read FShowActive write FShowActive; 
    property Clicked: Boolean read FClicked write SetFClicked; 
    property VLinkColor: TColor read FClick write SetFClick; 
    property LinkColor: TColor read FNormal write SetFNormal; 
    property ALinkColor: TColor read FActive write SetFActive; 
    property AsLink: Boolean read FAsLink write setFAsLink; 
    property Switch: Boolean read FSwitch write FSwitch; 
  end; 
 
procedure Register; 
 
implementation 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TLLabel]); 
end; 
 
constructor TLLabel.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FActive := clRed; 
  FNormal := clBlue; 
  FClick := clfuchsia; 
  FAsLink := true; 
  FShowActive := true; 
  Font.Style := [fsUnderline]; 
  Font.color := setColor; 
end; 
 
function TLLabel.SetColor: TColor; 
begin 
  if FClicked then result := FClick else result := FNormal; 
end; 
 
procedure TLLabel.MEnter(var EMsg: TMessage); 
begin 
  Fwithin := true; 
  if FAsLink and FShowActive then Font.Color := FActive; 
  if assigned(FOnEnter) then FOnEnter(self); 
end; 
 
procedure TLLabel.MLeave(var LMsg: TMessage); 
begin 
  Fwithin := false; 
  if FAsLink then Font.Color := SetColor; 
  if assigned(FOnLeave) then FOnLeave(self); 
end; 
 
procedure TLLabel.MUp(var CMsg: TMessage); 
begin 
  if FSwitch then FClicked := not FClicked 
  else FClicked := true; 
  if FAsLink and (not FShowActive) then Font.Color := SetColor; 
  inherited; 
end; 
 
procedure TLLabel.SetFNormal(f: TColor); 
begin 
  if FNormal <> f then begin 
    FNormal := f; 
    if FAsLink and not FClicked then Font.Color := f; 
  end; 
end; 
 
procedure TLLabel.setFClicked(b: Boolean); 
begin 
  if b = FClicked then exit; 
  FClicked := b; 
  if FAsLink then Font.color := setColor; 
end; 
 
procedure TLLabel.SetFActive(f: TColor); 
begin 
  if FActive <> f then begin 
    FActive := f; 
    if FAsLink and Fwithin then Font.Color := f; 
  end; 
end; 
 
procedure TLLabel.SetFClick(f: TColor); 
begin 
  if FClick <> f then begin 
    FClick := f; 
    if FAsLink and FClicked then Font.Color := f; 
  end; 
end; 
 
procedure TLLabel.SetFAsLink(b: Boolean); 
begin 
  if b = FAsLink then exit; 
  FAsLink := b; 
  if b then Font.Color := SetColor else Font.Color := clWindowText; 
end; 
 
end.