TStickyLabel control anyone?

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.