Как поймать момент, когда родительский элемент управления был изменен?

Question

У меня есть визуальный компонент, полученный из TWinControl. Мне нужно сделать некоторую работу в моем компоненте, когда его родительский элемент управления был изменен. В общем случае свойство «Выровнять» моего компонента равно alNone.

Как отловить событие изменения размера родительского элемента управления? Возможно ли это?

Answer 1

Если размер 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, что может запутать пользователя вашего компонента. Можно легко показать или вернуть 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.

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

Да, Эндрю, я думаю, что присоединение вашего компонента к циклу сообщений родителя (создание его подкласса) - это путь.Для этого вы можете использовать TControl.WindowProc свойство. doc объясняет, что вам нужно сохранить оригинал и восстановить его позже (в деструкторе вашего компонента), а также передать сообщения исходному обработчику, т.е. ваша замена должна выглядеть как

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

Если вы хотите сделать это «в старом стиле», используйте API SetWindowLongPtr с GWLP_WNDPROC, но AFAIK WindowProc был введен именно по той причине, чтобы упростить подкласс для компонентов,т. е. в этом нет ничего плохого.

Answer 4

Я искал решение похожей проблемы. Но в моем случае у меня не может быть таких ограничений на выравнивание, и подклассы казались излишними (вещь выравнивания выглядит слишком излишней, теперь, когда я смотрю на это)

Итак, мне пришла в голову следующая идея:

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