delphi - 如何捕捉父控件调整大小的时刻?

标签 delphi resize components parent-child parent

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

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

最佳答案

如果 TWinControl(父级)的大小发生更改,则在 WM_SIZE 处理程序中调用 TWinControl.Realign。此过程通过 TWinControl.AlignControls 冒泡,迭代所有将 Align 属性设置为除 alNone 之外的任何值的子控件。当设置为 alCustom 时,将使用不变的参数调用子控件的 SetBounds,即使它们的大小由于 anchor 的参与而发生或未发生变化。

因此,将 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.

关于delphi - 如何捕捉父控件调整大小的时刻?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/6923432/

相关文章:

reactjs - 如何在 react.js 中仅在一个组件中导入 Bootstrap

delphi - 为什么将此汇编代码移植到 x64 时会出现访问冲突?

macos - NSTextField sizeToFit 或框架更新将文本向左移动

c# - TableLayoutPanel 中的列大小在设计器中不断变化

reactjs - 依赖于第三方库或框架的组件库

javascript - 如何在 React 中应用外部 SetState

delphi - 遗留 Delphi 项目中的 32 位透明 PNG 问题

德尔福XE2 : Application build with runtime package with FireMonkey framework

delphi - TADO查询已准备

jquery - 使用 jQuery 在窗口调整大小时动态更改 CSS