delphivcldelphi-12-athens

How to make a custom VCL control detect when another VCL control has moved?


What I am trying to do is write a custom TLabel that is coupled to another control, for example a TDBEdit, and the label will always position itself relative to the control's position, and when this position changes, the label will correct its own position.

This needs to work especially at design-time, too.

But, there does not seem to be events for when a control's position changes.

I was hoping to subscribe to the control's events that fire when the control is moved, but I cant find any such events.

This is the code for the custom label:

type
  TggLabel = class(TLabel)
  private
    FggControl: Twincontrol;
    procedure SetggControl(const Value: Twincontrol);
  protected
  public
  published
    property ggControl : Twincontrol read FggControl write SetggControl;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('gg', [TggLabel]);
end;

{ TggLabel }

procedure TggLabel.SetggControl(const Value: Twincontrol);
begin
  if FggControl <> Value then
  begin
    FggControl := Value;

    if FggControl <> NIL then
    begin
      // I was hoping to subscribe here on events that fire when the control has moved
    end;
  end;
end;

I looked at how they do it in TLabeledEdit, but it looks like they do it in the SetBounds() of the Edit control, which is not useful for me since I want to do it from my Label not the Edit.

I'm using Delphi 12 Community Edition.


Solution

  • I was hoping to subscribe to the control's events that fire when the control is moved, but I cant find any such events.

    Unfortunately, there is no such event. What you can do instead is subclass the target control's WindowProc property to intercept WM_WINDOWPOSCHANGED messages, which TControl.SetBounds() sends to the control after updating its Left/Top/Width/Height properties, eg:

    type
      TggLabel = class(TLabel)
      private
        FggControl: TControl;
        FggOrigWndProc: TWndMethod;
        procedure ggControlPosChanged;
        procedure ggControlWndProc(var Message: TMessage);
        procedure SetggControl(const Value: TControl);
      protected
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
      published
        property ggControl : TControl read FggControl write SetggControl;
      end;
    
    ...
    
    procedure TggLabel.Notification(AComponent: TComponent; Operation: TOperation);
    begin
      inherited;
      if (Operation = opRemove) and (AComponent = FggControl) then
        FggControl := nil;
    end;
    
    procedure TggLabel.ggControlPosChanged;
    begin
      // use ggControl's new position as needed ...
    end;
    
    procedure TggLabel.ggControlWndProc(var Message: TMessage);
    begin
      FggOrigWndProc(Message);
      if Message.Msg = WM_WINDOWPOSCHANGED then
        ggControlPosChanged;
    end;
    
    procedure TggLabel.SetggControl(const Value: TControl);
    begin
      if FggControl <> Value then
      begin
        if FggControl <> nil then
        begin
          FggControl.RemoveFreeNotification(Self);
          FggControl.WindowProc := FggOrigWndProc;
          FggOrigWndProc := nil;
        end;
    
        FggControl := Value;
    
        if FggControl <> nil then
        begin
          FggControl.FreeNotification(Self);
          Parent := FggControl.Parent;
          FggOrigWndProc := FggControl.WindowProc;
          FggControl.WindowProc := ggControlWndProc;
          ggControlPosChanged;
        end;
      end;
    end;