TStickyLabel control anyone?

Question

I was inspired with this question How I can detect when other control changes it bounds? and @Remy Lebeau's answer and decided to write my own control (based on ideas from ExtCtrls.TLabeledEdit).

Now I have a few concept problems:

1. Should I re-use already defined TLabelPosition type or use my own? I was thinking that if I use ExtCtrls.TLabelPosition my control will be depended on ExtCtrls and if I use the same name in my unit, there might be a conflict when the 2 controls are used together.

2. Basically the control is always in AutoSize state, but I needed a so called Fixed Width/Height (I called it LabelWidth) so that the text could auto-wrap in that mode. not sure if the concept/naming is right.

3. I would also like to create a Left/Right anchor that always stick to a fixed parent positoin (for now its called _FOriginX) - not sure about naming/concept yet.

4. Todo: consider Control Align? (when it's not alNone) - How to sick my label in that case?

In any way the control works really nice. It can be sticked to any TControl.

Any thoughts/ideas/improvements would be nice. Feel free to modify and share if you like it :)

---

unit StickyLabel;
{$DEFINE DEBUG}
interface

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

type
  TStickyLabelPosition = (slpAbove, slpBelow, slpLeft, slpRight);

  TStickyLabel = class(TCustomLabel)
  private
    _FOriginX: Integer; // not used yet
    FControl: TControl;
    FControlWndProc: TWndMethod;
    FLabelWidth: Integer;
    FLabelHeight: Integer;
    FLabelPosition: TStickyLabelPosition;
    FLabelSpacing: Integer;
    FSkipAdjustBounds: Boolean;
    function GetAlignment: TAlignment;
    function GetTop: Integer;
    function GetLeft: Integer;
    function GetLayout: TTextLayout;
    function GetWidth: Integer;
    function GetHeight: Integer;
    procedure SetAlignment(const Value: TAlignment);
    procedure SetHeight(Value: Integer);
    procedure SetWidth(Value: Integer);
    procedure SetControl(AControl: TControl);
    procedure SetLabelPosition(const Value: TStickyLabelPosition);
    procedure SetLabelSpacing(const Value: Integer);
    procedure SetLabelWidth(const Value: Integer);
    procedure SetLabelHeight(const Value: Integer);
    procedure SetLayout(Value: TTextLayout);
    procedure ControlWndProc(var Message: TMessage);
  protected
    function GetClientRect: TRect; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoPositionLabel; virtual;
    {$IFDEF DEBUG}
    procedure Paint; override;
    {$ENDIF}
  public
    procedure AdjustBounds; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property LabelWidth: Integer read FLabelWidth write SetLabelWidth default 0;
    property LabelHeight: Integer read FLabelHeight write SetLabelHeight default 0;
    property LabelPosition: TStickyLabelPosition read FLabelPosition write SetLabelPosition default slpAbove;
    property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3;
    property Control: TControl read FControl write SetControl;

    property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify;
    property BiDiMode;
    property Caption;
    property Color;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Font;
    property Height: Integer read GetHeight write SetHeight;
    property Left: Integer read GetLeft;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Top: Integer read GetTop;
    property Transparent;
    property Layout read GetLayout write SetLayout default tlCenter;
    property WordWrap stored False; // todo: hide from published
    property Width: Integer read GetWidth write SetWidth;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TStickyLabel]);
end;

constructor TStickyLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Layout := tlCenter;
  FLabelPosition := slpAbove;
  FLabelSpacing := 3;
  FLabelWidth := 0;
  FLabelheight := 0;
  _FOriginX := -1; // todo? this would be a Left/Right anchor
end;

destructor TStickyLabel.Destroy;
begin
  SetControl(nil);
  inherited;
end;

procedure TStickyLabel.SetControl(AControl: TControl);
begin
  if AControl = Self then Exit;

  if FControl <> AControl then
  begin
    if FControl <> nil then
    begin
      FControl.WindowProc := FControlWndProc;
      FControl.RemoveFreeNotification(Self);
    end;
    FControl := AControl;
    if FControl <> nil then
    begin
      FControlWndProc := FControl.WindowProc;
      FControl.WindowProc := ControlWndProc;
      FControl.FreeNotification(Self);
    end else
      FControlWndProc := nil;

    if FControl <> nil then
    begin
      Parent := FControl.Parent;
      AdjustBounds;
    end;
  end;
end;

procedure TStickyLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FControl) then
  begin
    FControl := nil;
    FControlWndProc := nil;
    //FreeAndNil(Self); // option ?
  end;
end;

procedure TStickyLabel.ControlWndProc(var Message: TMessage);
begin
  if Assigned(FControlWndProc) then
    FControlWndProc(Message);

  case Message.Msg of
    CM_ENABLEDCHANGED: Enabled := FControl.Enabled;
    CM_VISIBLECHANGED: Visible := FControl.Visible;
    WM_WINDOWPOSCHANGED:
      begin
        if Parent <> FControl.Parent then
          Parent := FControl.Parent;
        AdjustBounds;
      end;
  end;
end;

procedure TStickyLabel.AdjustBounds;
begin
  if FSkipAdjustBounds then Exit;
  inherited AdjustBounds;
  // if not (csReading in ComponentState) then // is this needed?
  DoPositionLabel;
end;

function TStickyLabel.GetAlignment: TAlignment;
begin
  Result := inherited Alignment;
end;

function TStickyLabel.GetLayout: TTextLayout;
begin
  Result := inherited Layout;
end;

function TStickyLabel.GetClientRect: TRect;
begin
  Result := Rect(0, 0, Width, Height);
end;

function TStickyLabel.GetHeight: Integer;
begin
  if (FLabelHeight <> 0) then
    Result := FLabelHeight else
    Result := inherited Height
end;

function TStickyLabel.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TStickyLabel.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TStickyLabel.GetWidth: Integer;
begin
 if (FLabelWidth <> 0) then
    Result := FLabelWidth else
    Result := inherited Width
end;

procedure TStickyLabel.SetAlignment(const Value: TAlignment);
begin
  if inherited Alignment <> Value then
  begin
    inherited Alignment := Value;
    AdjustBounds;
  end;
end;

procedure TStickyLabel.SetLayout(Value: TTextLayout);
begin
  if inherited Layout <> Value then
  begin
    inherited Layout := Value;
    AdjustBounds;
  end;
end;

procedure TStickyLabel.SetHeight(Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TStickyLabel.SetWidth(Value: Integer);
begin
  {
  // trying to resize the TStickyLabel in design mode - does not work (move to SetBounds?)
  if (csDesigning in ComponentState) and (FLabelWidth <> 0) and (FLabelWidth <> Value) then
  begin
    LabelWidth := Value;
    Exit;
  end;
  }
  SetBounds(Left, Top, Value, Height);
end;

procedure TStickyLabel.SetLabelWidth(const Value: Integer);
begin
  if Value <> FLabelWidth then
  begin
    FLabelWidth := Value;
    FSkipAdjustBounds := True; // prevent call to  AdjustBounds twice (WordWrap calls it)
    try
      WordWrap := Value <> 0;
    finally
      FSkipAdjustBounds := False;
    end;
    AdjustBounds;
  end;
end;

procedure TStickyLabel.SetLabelHeight(const Value: Integer);
begin
  if Value <> FLabelHeight then
  begin
    FLabelHeight := Value;
    AdjustBounds;
  end;
end;

procedure TStickyLabel.SetLabelPosition(const Value: TStickyLabelPosition);
begin
  if Value <> FLabelPosition then
  begin
    FLabelPosition := Value;
    AdjustBounds;
  end;
end;

procedure TStickyLabel.SetLabelSpacing(const Value: Integer);
begin
  if Value <> FLabelSpacing then
  begin
    FLabelSpacing := Value;
    AdjustBounds;
  end;
end;

function AdjustedAlignment(RightToLeftAlignment: Boolean; Alignment: TAlignment): TAlignment;
begin
  Result := Alignment;
  if RightToLeftAlignment then
    case Result of
      taLeftJustify: Result := taRightJustify;
      taRightJustify: Result := taLeftJustify;
    end;
end;

procedure TStickyLabel.DoPositionLabel;
var
  P: TPoint;
  LAlignment: TAlignment;
  LWidth, LHeight: Integer;
begin
  if FControl = nil then Exit;

  LAlignment := AdjustedAlignment(UseRightToLeftAlignment, Alignment);

  LWidth := Width;
  LHeight := Height;

  case FLabelPosition of
    slpAbove:
      P.y := FControl.Top - LHeight - FLabelSpacing;
    slpBelow:
      P.y := FControl.Top + FControl.Height + FLabelSpacing;
    slpLeft:
      if UseRightToLeftAlignment {and options} then
        P.x := FControl.Left + FControl.Width + FLabelSpacing
      else
        P.x := FControl.Left - LWidth - FLabelSpacing;
    slpRight:
      if UseRightToLeftAlignment {and options} then
        P.x := FControl.Left - LWidth - FLabelSpacing
      else
        P.x := FControl.Left + FControl.Width + FLabelSpacing;
  end;
  case FLabelPosition of
    slpAbove, slpBelow:
      case LAlignment of
        taLeftJustify: P.x := FControl.Left;
        taRightJustify: P.x := FControl.Left + FControl.Width - LWidth;
        taCenter: P.x := FControl.Left + ((FControl.Width - LWidth) div 2);
      end;
    slpLeft, slpRight:
      case Layout of
        tlTop: P.y := FControl.Top;
        tlCenter: P.y := FControl.Top + ((FControl.Height - LHeight) div 2);
        tlBottom: P.y := FControl.Top + FControl.Height - LHeight;
      end;
  end;
  //if _FOriginX <> -1 then P.x := _FOriginX // ???
  SetBounds(P.x, P.y, LWidth, LHeight);
end;

{$IFDEF DEBUG}
procedure TStickyLabel.Paint;
begin
  inherited;
    with Canvas do
    begin
      Pen.Style := psDot;
    Pen.Color := clGray;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
end;
{$ENDIF}

end.