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
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.