如何捕捉调整父控件大小的时刻？

Question

我有一个从 TWinControl 派生的可视组件。当它的父控件被调整大小时，我需要在我的组件中做一些工作。一般情况下，我的组件的“Align”属性是 alNone。

如何捕捉调整父控件大小的事件？有可能吗？

Answer 1

我正在寻找类似问题的解决方案。但在我的情况下，我不能对对齐有这样的限制，而且子类化似乎有点过分了（对齐的东西看起来也过分了，现在我看着它）

于是我想出了以下想法：

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;

使用您正在跟踪的任何尺寸添加或替换 FParentLastWidth（我只需要在父宽度更改时做出反应。您可以将其视为一种优化，以免对对您的组件没有任何影响的各种更改做出反应）

Answer 2

警告：完全重写。谢谢罗！！

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

Answer 3

如果 TWinControl（父级）的大小发生更改，则在 WM_SIZE 处理程序中调用 TWinControl.Realign。这会通过TWinControl.AlignControls 冒泡到迭代所有将 Align 属性设置为其他任何内容的子控件，然后是alNone。当设置为alCustom 时，子控件的SetBounds 将使用不变的参数被调用，即使它们的大小由于锚的参与而改变或没有改变。

所以，将 Align 设置为 alCustom，您就会收到关于父级调整大小的通知：

  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;

我现在能想到的唯一缺点是 Align 属性永远不能是alNone，这可能会使组件的用户感到困惑。当内部继承属性仍设置为alCustom 时，很容易显示或返回alNone，但这不是建议，只会更加混乱。只需将alCustom 设置视为此组件的一项功能即可。

注意：通过这种结构，组件的用户仍然可以自己实现自定义对齐。

这是我的测试代码。也许您想为自己添加一些测试。

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 4

是的，Andrew，我认为将您的组件附加到父级的消息循环（子类化它）是要走的路。为此，您可以使用 TControl.WindowProc 属性。 doc 解释说您必须保存原始文件并稍后恢复（在组件的析构函数中），并将消息传递给原始处理程序，即您的替换应该看起来像

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

如果您想以“老套”的方式进行操作，请将SetWindowLongPtr API 与GWLP_WNDPROC 一起使用，但AFAIK 引入WindowProc 的原因正是为了更容易对组件进行子类化，即没有任何问题使用它。

Answer 5

以下是可以帮助您的示例：

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;