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

时间：2011-08-03 08:09:50

标签： delphi resize components parent-child parent

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

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

5 个答案:

答案 0 :(得分：7)

如果更改了TWinControl（父级），则在TWinControl.Realign处理程序中调用WM_SIZE。这会通过TWinControl.AlignControls冒泡到迭代所有子控件，这些控件的Align属性设置为alNone之外的任何其他值。当设置为alCustom时，将使用未更改的参数调用子控件的SetBounds，即使它们的大小因锚参与而已更改或未更改。

因此，将对齐设置为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，这可能会使组件的用户感到困惑。当内部继承属性仍设置为alNone时，很容易显示或返回alCustom，但这不是建议，只会混淆更多。只需将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.

答案 1 :(得分：1)

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

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

如果您想以“老套”方式执行此操作，请使用GWLP_WNDPROC API与WindowProc，但AFAIK {{1}}的引入正是为了使其更容易子类化组件，即使用它没什么不对。

答案 2 :(得分：1)

警告：完全重写。谢谢Rob !!

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

答案 3 :(得分：0)

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

所以我提出了以下想法：

SELECT
      tblprocedimento.idProcedimento,
      tblprocedimento.tituloProcedimento,
      tblprocedimento.tipoProximoS,
      tblprocedimento.numeroProximoS,
      tblprocedimento.tipoProximoN,
      tblprocedimento.numeroProximoN,
      ap1.nomeProximo AS nomeProximoS,
      ap2.nomeProximo AS nomeProximoN,
      tblauxtextoprocedimento.textoProcedimento,
      tblauxprocedimento.sTipificacao,
      tblNivel1.nivel1,
      tblNivel2.nivel2,
      tblNivel3.nivel3,
      tblNivel4.nivel4   
    FROM
    tblAuxTextoProcedimento
    LEFT JOIN 
    tblAuxProcedimento 
    ON 
    tblAuxTextoProcedimento.idTextoProcedimento = tblAuxProcedimento.sTextoProcedimento,
    tblNivel4 INNER JOIN (tblNivel3
    INNER JOIN (tblNivel2
    INNER JOIN (tblNivel1
    INNER JOIN tblAuxTipificacao
    ON tblNivel1.idNivel1 = tblAuxTipificacao.sNivel1)
    ON tblNivel2.idNivel2 = tblAuxTipificacao.sNivel2)
    ON tblNivel3.idNivel3 = tblAuxTipificacao.sNivel3)
    ON tblNivel4.idNivel4 = tblAuxTipificacao.sNivel4,
      tblprocedimento,
      tblauxproximo As ap1,
      tblauxproximo As ap2
    WHERE
      ap2.idProximo = tblprocedimento.sProxN AND
      ap1.idProximo = tblprocedimento.sProxS AND
      tblprocedimento.idProcedimento = 1 AND
      tblAuxProcedimento.sProcedimento = 1 AND
      tblAuxTipificacao.idTipificacao = 130

添加或替换您跟踪的任何大小的FParentLastWidth（我只需要在父宽度更改时进行反应。您可以将其作为优化，以便不对所有类型的更改作出反应，这对您的组件没有影响）< / p>

答案 4 :(得分：-1)

以下是帮助您的示例：

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;
相关问题
最新问题