(************************************************************************
*    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 AHMTStickyLabel;

interface

uses
  Classes,StdCtrls,Controls,Messages,Forms,Windows,AHMStdClass;
type
  TAHMStdPosition    = (pLeft,pRight,pTop,pBottom);
  TAHMStickyLabel = class(TLabel)
  private
    FAboutStr : TAHMAboutSControlStr;
    FAttachTo: TWinControl;
    FPosition: TAHMStdPosition;
    FSpace : Integer;
    FDefAttachedProc: Pointer;
    FAttachedInstance: Pointer;
    FRealigning: Boolean;
    Procedure SetSpace(Value: Integer);
    procedure SetAttachTo(Value: TWinControl);
    Procedure SetPosition(Value: TAHMStdPosition);
    procedure AttachedWndProc(var Message: TMessage);
  protected
    procedure CheckForControl;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Loaded; override;
    Procedure ReAlign;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property Position: TAHMStdPosition read FPosition write SetPosition default pLeft;
    property AttachToControl: TWinControl read FAttachTo write SetAttachTo;
    Property Space : Integer Read FSpace write SetSpace Default 5;
  end;
implementation

constructor TAHMStickyLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSpace := 5;
  FRealigning := False;
  FAttachedInstance := MakeObjectInstance(AttachedWndProc);
end;

procedure TAHMStickyLabel.Loaded;
begin
  inherited;
end;

destructor TAHMStickyLabel.Destroy;
begin
  if Assigned(FAttachTo) and IsWindow(FAttachTo.Handle) then
     SetWindowLong(FAttachTo.Handle, GWL_WNDPROC,
                   Longint(FDefAttachedProc));
  FreeObjectInstance(FAttachedInstance);
  inherited Destroy;
end;

procedure TAHMStickyLabel.AttachedWndProc(var Message: TMessage);
begin
  with Message do
  begin
    case Msg of WM_MOVE, WM_SIZE : ReAlign; end;
    Result := CallWindowProc(FDefAttachedProc, FAttachTo.Handle, Msg, WParam, LParam);
  end;
end;

procedure TAHMStickyLabel.CheckForControl;
var
  I: Integer;
  RCDest: TRect;
begin
  with Owner do
  begin
    for I := 1 to ComponentCount do
    if (Components[I - 1] is TWinControl) and (Components[I - 1] <> Self) then
    with Components[I - 1] as TWinControl do
    begin
      IntersectRect(RCDest, Self.BoundsRect, BoundsRect);
      if not IsRectEmpty(RCDest) then
      begin
        AttachToControl := Owner.Components[I - 1] as TWinControl;
        FocusControl := Owner.Components[I - 1] as TWinControl;
        ReAlign;
        break;
      end;
    end;
  end;
end;

procedure TAHMStickyLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FAttachTo) then FAttachTo := Nil;
  inherited Notification(AComponent,Operation);
end;

procedure TAHMStickyLabel.WndProc(var Message: TMessage);
begin
  with Message do
  begin
    case Msg of
      WM_WINDOWPOSCHANGED:
      if (not FRealigning) and (csDesigning in ComponentState) then CheckForControl;
    end;
  end;
  inherited WndProc(Message);
end;

procedure TAHMStickyLabel.SetAttachTo(Value: TWinControl);
begin
  if (FAttachTo <> Value) then
  begin
    if Assigned(FAttachTo) and IsWindow(FAttachTo.Handle) then
       SetWindowLong(FAttachTo.Handle, GWL_WNDPROC, Longint(FDefAttachedProc));
    FAttachTo := Value;
    if Assigned(FAttachTo) and IsWindow(FAttachTo.Handle) then
    begin
      FDefAttachedProc := Pointer(GetWindowLong(FAttachTo.Handle, GWL_WNDPROC));
      SetWindowLong(FAttachTo.Handle, GWL_WNDPROC, Longint(FAttachedInstance));
    end;
    ReAlign;
  end;
end;

Procedure TAHMStickyLabel.SetPosition(Value: TAHMStdPosition);
begin
  If (FPosition <> Value) then
  begin
    FPosition := Value;
    ReAlign;
  end;
end;

Procedure TAHMStickyLabel.SetSpace(Value: Integer);
begin
  If (FSpace <> Value) Then
  begin
    FSpace := Value;
    ReAlign;
  end;
end;

Procedure TAHMStickyLabel.ReAlign;
var
  xTop, xLeft: Integer;
begin
  FRealigning := True;
  xTop:=0; xLeft:=0;
  If FAttachTo <> Nil then
  begin
    Case FPosition of
       pLeft: begin xTop :=  FAttachTo.Top; xLeft:=FAttachTo.Left-Width - FSpace ; end ;
       pRight: begin xTop:=FAttachTo.Top; xLeft:=FAttachTo.Left+FAttachTo.Width+FSpace; end ;
       pTop: begin xTop:=FAttachTo.Top-Height-FSpace; xLeft:=FAttachTo.Left; end;
       pBottom: begin xTop:=FAttachTo.Top+FAttachTo.Height+FSpace; xLeft:=FAttachTo.Left; end;
    end;
    SetBounds(xLeft, xTop, Width, Height);
  end;
  FRealigning := False;
end;

end.
