(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDBCommandLabel;
interface

uses
  Windows,Messages,Classes,Forms,StdCtrls,ShellAPI,Graphics,
  Controls,DB,DBCtrls,AHMStdClass;

type
  TAHMDBCommand=(runNothing,runMAIL,runURL,runFTP,runFILE,runEVENT);
  TAHMDBCommandLabel = class(TDBText)
  private
    FAboutStr : TAHMAboutSControlStr;
    FCommand : TAHMDBCommand;
    FActiveColor : TColor;
    NFontColor : TColor;
    FMOver : TColor;
    Followed : Boolean;
    Pushed,FDown,FEnabled,MouseIn : Boolean;
    foncommand : TNotifyevent;
    Procedure WMMouseMove(var msg: TWMMouseMove);Message WM_MOUSEMOVE;
    Procedure WMLButtonDown(var msg: TWMLButtonDown);Message WM_LButtonDown;
    Procedure WMLButtonUp(var msg: TWMLButtonUp);Message WM_LButtonUp;
  protected
  public
    constructor Create(AOwner:TComponent);override;
    procedure Click; override;
    procedure Loaded; override;
    destructor Destroy; override;
 published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr; 
    property Command : TAHMDBCommand read FCommand write FCommand default runUrl;
    property FollowedColor : TColor read FActiveColor write FActiveColor default clPurple;
    property MoveOverColor : TColor read FMover write FMover default clRed;
    property RunEvent : TNotifyevent read foncommand write foncommand;
  end;

implementation
{$I AHM.INC}
const Command_Strings : array [TAHMDBCommand] of string=('','mailto:','http://','ftp://','file:','event');

constructor TAHMDBCommandLabel.Create(AOwner:TComponent);
begin
  FMOver:=clRed;
  FCommand := runURL;
  FActiveColor := clPurple;
  Followed :=False;
  inherited Create(AOwner);
  {$IFDEF AHMINPRISE3}
  Cursor := crHandPoint;
  {$ENDIF}
  Caption := 'http://www.tritontools.com';
  with Font do
  begin
    Size:=10;
    Color:=clBlue;
    Style := [fsUnderline];
  end;
end;

procedure TAHMDBCommandLabel.Loaded;
begin
  inherited Loaded;
  NFontColor := Font.color;
end;

Destructor TAHMDBCommandLabel.Destroy;
begin
  inherited Destroy;
end;

procedure TAHMDBCommandLabel.Click;
begin
  if Enabled then inherited Click;
end;

Procedure TAHMDBCommandLabel.WMLButtonDown(var msg: TWMLButtonDown);
var Tmp : string;
begin
  if Enabled and visible then
  begin
   Pushed := True;
   MouseIn := True;
   Font.Color := NFontColor;
   Followed:=true;
   inherited;
   Tmp:=Command_Strings[Command];
   if Pos(Tmp,Caption) = 1 then Tmp := '';
   if Tmp<>'event' then
     ShellExecute(0,'open',PChar(Tmp + Caption),nil,nil,SW_NORMAL) else
   if assigned(foncommand) then foncommand(self);
  end;
end;

Procedure TAHMDBCommandLabel.WMLButtonUp(var msg: TWMLButtonUp);
Begin
  if Enabled and visible and Pushed then
  Begin
   Pushed := False;
   MouseIn := False;
   Font.Color := FActiveColor;
   inherited;
  end;
end;

Procedure TAHMDBCommandLabel.WMMouseMove(Var msg: TWMMouseMove);
begin
  if not MouseCapture then
  begin
    SetCaptureControl(Self);
    if Enabled and Visible and getParentForm(Self).Active then Font.Color := FMOver;
  end;
  if MouseCapture and ((msg.xpos<0) or (msg.ypos<0) or
    (msg.xPos>Width) or (msg.Ypos>Height)) and mousein then
  begin
    MouseIn := False;
    if followed  then Font.Color :=FActiveColor else Font.Color:=NFontColor;
    SetCaptureControl(Nil);
  end;
  if MouseCapture and ((msg.xpos>=0) and (msg.ypos>=0) and (msg.xPos<=Width)
                  and (msg.Ypos<=Height)) and not MouseIn then
  begin
    MouseIn := True;
    if not FDown and FEnabled then Font.Color := FMOver;
  end;
  inherited;
end;

end.
