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

我有一个来自TWinControl的可视组件。当组件的父控件调整大小后，我需要在组件中执行一些工作。在一般情况下，我的组件的“Align”属性是alNone

---

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

以下是帮助您的示例：

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;

---

是的，Andrew，我认为将组件附加到父级消息循环（将其子类化）是一种方法。为此，您可以使用

t控件.WindowProc

属性。说明您必须保存原始文件，并在以后（在组件的析构函数中）还原它，还必须将消息传递给原始处理程序，即您的替换文件应该是这样的

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

如果你想用“老生常谈”的方式来做，可以使用带有

GWLP\u WNDPROC

的API，但是如果引入

WindowProc

正是为了使组件子类化更容易，也就是说使用它没有什么错。

如果TWinControl（父控件）的大小发生变化，然后在

WM\u SIZE

处理程序中调用

TWinControl.reallign

。这将通过

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;

---

警告：完全重写。谢谢你，罗布

使用SetWindowsSubClass的示例

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.

---

我在寻找类似问题的解决方案。但在我的例子中，我不能对对齐有这样的限制，子类化似乎有些过火（现在我看到对齐的东西看起来也过火了）

所以我想到了以下想法：

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;

类型
TMyComponent=类（TControl）
私有的
FParentLastWidth：整数；
...
程序失效；推翻
...
结束；
程序TMY组件。无效；
开始
如果是（父项nil）和（FParentLastWidth父项.Width），则
开始
FParentLastWidth:=父.Width；
//在父对象调整大小时执行任何操作
结束；
继承；
结束；

---

添加FParentLastWidth或将其替换为您正在跟踪的任何大小（我只需要在父级宽度更改时做出反应。您可以将其视为一种优化，以避免对所有类型的更改做出反应，而这些更改对组件没有影响）

这不是个好主意-OP编写自定义控件，控件不应使用其父事件属性；如果控件的用户也想使用该事件，该怎么办？这只是一个例子。解决方案是：将resize方法分配给所有TWinControl，并在OnResize启动时使用接口IResizeAction（或类似的东西）调用所有OnParentResize for childs。我是否可以以某种方式钩住消息循环并捕获父句柄的WM_大小？@Andrew它不会通过消息循环到达<代码>WM_大小同步交付。我想您可以替换父级的窗口过程，但我希望有一个更好的解决方案。替换窗口过程与附加到父级的消息循环不同。事实上，附加到父级的消息循环没有意义。Windows没有消息循环。线程确实有消息队列，它们由消息循环泵送。在这个例子中，

WM_SIZE

消息不是通过队列传递的，它是一条已发送的消息。是的，我的措辞错误。。。但是idea本身（挂接到父级的WNDPC）应该可以工作。使用WindowProc时出现了一些错误，这与使用SetWindowLong时出现的错误是一样的：创建控件1、创建控件2、删除控件1，然后看着程序在试图调用不再存在的控件的窗口过程时崩溃。Rob Kennedy:我就快到了，但是如何控制子类ID呢？因为每个控件都有一个ID？我不能使用ComponentIndex或ControlIndex，因为发生了冲突-你的建议是什么？@Fabricio对象的地址如何-应该是唯一的？在专注于答案的实现时，你忽略了这个问题，这个问题需要通知父控件发生的事件。您不能重写外部类的方法，尤其是在您已经发布产品之前不知道这些类将是什么的情况下。@Fabrico Araujo:这段代码有问题，因为SetWindowsSubClass总是返回FALSE。可能是因为父属性是在父窗口句柄仍然不存在时分配的？@Fabricio Araujo:我对您的解决方案进行了一些编辑（添加了调整大小处理程序）。当我从代码中创建组件的实例时，它工作得很好，但是当我把它放在表单上时，它就不工作了，请参见我前面的评论。@Andrew:我想是这样的。今天晚些时候我将尝试解决这个问题。我将尝试动态创建一个实例

LB:TExampleClass

，如下所示：

过程TForm1.FormCreate（发送方：TObject）；begin LB:=TExampleClass.Create（Self）；LB.SetBounds（Edit1.Left，Edit1.Top+Edit1.Height+Edit1.Top，Edit1.Width，LB.Height）；LB.父母：=自己；结束

关闭应用程序时会崩溃。我做错了什么？我已经测试了所有的解决方案，我认为这是最稳定的。谢谢。记住，当父控件调整大小时，子控件并不总是被重新绘制。你是对的。我在父窗体上有一些自定义绘图的东西，这可以解释为什么它在我所有的尝试案例中都有效。只有当子控件受到调整大小的影响时，删除这些控件才能使其工作。

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;