How to catch the moment when the parent control has been resized?

Question

I have a visual component derived from TWinControl. I need to do some work in my component when its parent control has been resized. In general case, the \"Align\" property

Answer 1

Here is exapmle to help you:

procedure TForm1.Button1Click(Sender: TObject);
var newMethod: TMethod;
begin
  newMethod.Code := MethodAddress('OnResizez'); //your action for parent resize
  newMethod.Data := Pointer(self);
  SetMethodProp(button1.Parent, 'OnResize',  newMethod); //set event to button1.parent
end;

procedure TForm1.OnResizez(Sender: TObject);
begin
  button1.Width :=   button1.Width+1; //action on resize
end;

Answer 2

I was looking for a solution to a similar problem. But in my case I cannot have such restrictions on alignment, and subclassing seemed overkill (the alignment thingie looks overkill too, now that I look at it)

So I came up with the following idea:

type
  TMyComponent = class(TControl)
  private
    FParentLastWidth: integer;
  ...
    procedure Invalidate; override;
  ...
  end;

procedure TMyComponent.Invalidate;
begin
  if (Parent <> nil) and (FParentLastWidth <> Parent.Width) then
  begin
    FParentLastWidth := Parent.Width;
    // do whatever when the parent resizes
  end;
  inherited;
end;

Add or replace the FParentLastWidth with whatever size you are tracking (I only needed reaction when the parent width changed. You can take it as an optimization so to not react to all kinds of changes which makes no difference for your component)

Answer 3

Yes, Andrew, I think attaching your component to parent's message loop (subclassing it) is the way to go. For that you can use TControl.WindowProc property. The doc explains that you have to save the original and restore it later (in the destructor of your component) and also to pass the messages to the original handler, ie your replacement should look like

procedure TMyComponent.SubclassedParentWndProc(Var Msg: TMessage);
begin
   FOldParentWndProc(Msg);
   if(Msg.Message = WM_SIZE)then begin
      ...
   end; 
end;

If you want to do it "old shool" way, use the SetWindowLongPtr API with GWLP_WNDPROC but AFAIK the WindowProc was introduced exactly for the reason to make it easier to subclass components, ie there is nothing wrong using it.

Answer 4

If a TWinControl (the parent) is changed in size, then TWinControl.Realign is called in the WM_SIZE handler. This bubbles via TWinControl.AlignControls into iterating over all the child controls which have the Align property set to anything else then alNone. When set to alCustom, SetBounds of the child controls will be called with unchanged arguments, even if their size has or has not changed due to anchor involvement.

So, set Align to alCustom and you have the notification of the parent's resize:

  TChild = class(T...Control)
  private
    FInternalAlign: Boolean;
    function GetAlign: TAlign;
    procedure ParentResized;
    procedure SetAlign(Value: TAlign);
  protected
    procedure RequestAlign; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property Align: TAlign read GetAlign write SetAlign default alCustom;
  end;

constructor TChild.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
end;

function TChild.GetAlign: TAlign;
begin
  Result := inherited Align;
end;

procedure TChild.ParentResized;
begin
end;

procedure TChild.RequestAlign;
begin
  FInternalAlign := True;
  try
    inherited RequestAlign;
  finally
    FInternalAlign := False;
  end;
end;

procedure TChild.SetAlign(Value: TAlign);
begin
  if Value = alNone then
    Value := alCustom;
  inherited Align := Value;
end;

procedure TChild.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if not FInternalAlign then
    if (Align <> alCustom) or ((ALeft = Left) and (ATop = Top) and
        (AWidth = Width) and (AHeight = Height)) then
      ParentResized;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

The only drawback I can think of for now is that the Align property can never be alNone, which could confuse the user of your component. It is easily possible to show or return alNone when the internal inherited property is still set to alCustom, but that is not an advice and would confuse only more. Just consider the alCustom setting as a feature of this component.

Note: with this construction, the user of your component is still able to implement custom alignment himself.

And here is my test code. Maybe you want add some testing for yourself.

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    TestButton: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure TestButtonClick(Sender: TObject);
  private
    FChild: TControl;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TChild = class(TGraphicControl)
  private
    FInternalAlign: Boolean;
    function GetAlign: TAlign;
    procedure ParentResized;
    procedure SetAlign(Value: TAlign);
  protected
    procedure Paint; override;
    procedure RequestAlign; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property Align: TAlign read GetAlign write SetAlign default alCustom;
  end;

{ TChild }

constructor TChild.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
end;

function TChild.GetAlign: TAlign;
begin
  Result := inherited Align;
end;

procedure TChild.Paint;
begin
  Canvas.TextRect(ClientRect, 2, 2, 'Parent resize count = ' + IntToStr(Tag));
end;

procedure TChild.ParentResized;
begin
  Tag := Tag + 1;
  Invalidate;
end;

procedure TChild.RequestAlign;
begin
  FInternalAlign := True;
  try
    inherited RequestAlign;
  finally
    FInternalAlign := False;
  end;
end;

procedure TChild.SetAlign(Value: TAlign);
begin
  if Value = alNone then
    Value := alCustom;
  inherited Align := Value;
end;

procedure TChild.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if not FInternalAlign then
    if (Align <> alCustom) or ((ALeft = Left) and (ATop = Top) and
        (AWidth = Width) and (AHeight = Height)) then
      ParentResized;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  FChild := TChild.Create(Self);
  FChild.SetBounds(10, 10, 200, 50);
  FChild.Parent := Self;
end;

procedure TForm1.TestButtonClick(Sender: TObject);
var
  OldCount: Integer;
begin
  OldCount := FChild.Tag;

  Width := Width + 25;                                                     //1
  MoveWindow(Handle, Left, Top, Width + 25, Height, True);                 //2
  SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height,
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);                   //3

  FChild.Anchors := [akLeft, akTop, akRight];
  Width := Width + 25;                                                     //4
  MoveWindow(Handle, Left, Top, Width + 25, Height, True);                 //5
  SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height,
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);                   //6

  FChild.Anchors := [akLeft, akTop];
  Panel1.Anchors := [akLeft, akTop, akRight];
  FChild.Parent := Panel1;                                                 //7
  Width := Width + 25;                                                     //8
  MoveWindow(Handle, Left, Top, Width + 25, Height, True);                 //9
  SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height,
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);                   //10

  FChild.Align := alRight;
  Width := Width + 25;                                                     //11
  MoveWindow(Handle, Left, Top, Width + 25, Height, True);                 //12
  SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height,
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);                   //13

  if FChild.Tag = OldCount + 13 then
    ShowMessage('Test succeeded')
  else
    ShowMessage('Test unsuccessful');
end;

end.

Answer 5

WARNING: Full rewrite. Thanks Rob!!

Example using SetWindowSubClass.

unit Example;

interface

uses
  Windows, Classes, Controls, StdCtrls, Messages, CommCtrl, ExtCtrls;

type
  TExampleClass = class(TlistBox)
  private
    procedure ActivateParentWindowProc;
    procedure RevertParentWindowProc;
  protected
    procedure SetParent(AParent: TWinControl); override;
  public
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;


  end;

function SubClassWindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
         lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
implementation


procedure TExampleClass.ActivateParentWindowProc;
begin
  SetWindowSubClass( Parent.Handle, SubClassWindowProc, NativeInt(Self), 0);
end;


procedure TExampleClass.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Parent) then
  begin
    RevertParentWindowProc;
  end;
end;


procedure TExampleClass.RevertParentWindowProc;
begin
  RemoveWindowSubclass( Parent.Handle,
                        SubClassWindowProc, NativeInt(Self));
end;

procedure TExampleClass.SetParent(AParent: TWinControl);
begin
  if Assigned(Parent) then
  begin
    RevertParentWindowProc;
  end;
  inherited SetParent(AParent);
  if Assigned(AParent) then
  begin
    ActivateParentWindowProc;
  end
  else
  begin
    RevertParentWindowProc;
  end;

end;

function SubClassWindowProc(hWnd: HWND; uMsg: UINT;
  wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR;
  dwRefData: DWORD_PTR): LRESULT;
begin
  if uMsg = WM_SIZE then
  begin
    // ...

  end;

  Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);


end;

end.