Delphi 允许多个子控件在其父控件调整大小时进行检测

我正在编写一个TSplitter子体，当其父控件调整大小时，它会按比例调整对齐控件的大小。为了检测父级调整大小，我将父级WinProc过程子类化

FOldWindowProc := Parent.WindowProc;
Parent.WindowProc := SubclassedParentWndProc;

当父级为单个拆分器的父级时，此功能非常有效。但是，当存在一个或多个拆分器时，其中只有一个可以正常工作

我如何才能收到父控件已调整大小的所有拆分器控件的通知

这是我的密码

unit ProportionalSplitterU;

interface

uses
  Windows, SysUtils, Controls, Messages, Classes, CommCtrl, ExtCtrls;

type
  TSPlitterHelper = class helper for TSplitter
  public
    function FindControlEx: TControl;
  end;

  TProportionalSplitter = class(TSplitter)
  private
    FOldWindowProc: TWndMethod;
    FControlRatio: Double;
    FProportionalResize: Boolean;

    procedure SubclassedParentWndProc(var Msg: TMessage);
    procedure SetRatio;
    procedure SetProportionalResize(const Value: Boolean);
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure StopSizing; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ProportionalResize: Boolean read FProportionalResize write SetProportionalResize;
  end;

implementation

{ TProportionalSplitter }

constructor TProportionalSplitter.Create(AOwner: TComponent);
begin
  inherited;

  FProportionalResize := True;
end;

procedure TProportionalSplitter.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation = opRemove) and
     (AComponent = Parent) then
  begin
    Parent.WindowProc := FOldWindowProc;
    FOldWindowProc := nil;
  end;
end;

procedure TProportionalSplitter.SetParent(AParent: TWinControl);
begin
  FControlRatio := -1;

  if Assigned(Parent) then
  begin
    Parent.WindowProc := FOldWindowProc;
  end;

  inherited SetParent(AParent);

  if Assigned(AParent) then
  begin
    FOldWindowProc := Parent.WindowProc;
    Parent.WindowProc := SubclassedParentWndProc;

    SetRatio;
  end;
end;

procedure TProportionalSplitter.SetProportionalResize(const Value: Boolean);
begin
  FProportionalResize := Value;

  SetRatio;
end;

procedure TProportionalSplitter.SetRatio;
var
  ActiveControl: TControl;
begin
  if FProportionalResize then
  begin
    ActiveControl := FindControlEx;

    if (Parent <> nil) and
       (ActiveControl <> nil) then
    begin
      case Align of
        alTop,
        alBottom: FControlRatio := ActiveControl.Height / Parent.Height;
        alLeft,
        alRight: FControlRatio := ActiveControl.Width / Parent.Width;
      end;
    end;
  end
  else
  begin
    FControlRatio := -1;
  end;
end;

procedure TProportionalSplitter.StopSizing;
begin
  inherited;

  SetRatio;
end;

procedure TProportionalSplitter.SubclassedParentWndProc(Var Msg: TMessage);
begin
  FOldWindowProc(Msg);

  if Msg.Msg = WM_SIZE then
  begin
    if FControlRatio <> -1 then
    begin
      case Align of
        alTop,
        alBottom: FindControlEx.Width := Round(Parent.Height * FControlRatio);
        alLeft,
        alRight: FindControlEx.Width := Round(Parent.Width * FControlRatio);
      end;
    end
    else
    begin
      SetRatio;
    end;
  end;
end;


{ TSPlitterHelper }

function TSPlitterHelper.FindControlEx: TControl;
begin
  Result := Self.FindControl;
end;

end.

Demo.dfm

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 478
  ClientWidth = 674
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 120
  TextHeight = 16
  object Panel1: TPanel
    Left = 0
    Top = 193
    Width = 249
    Height = 285
    Align = alLeft
    Caption = 'Panel1'
    TabOrder = 0
    ExplicitTop = 0
    ExplicitHeight = 478
  end
  object Panel2: TPanel
    Left = 249
    Top = 193
    Width = 425
    Height = 285
    Align = alClient
    Caption = 'Panel2'
    TabOrder = 1
    ExplicitTop = 0
    ExplicitHeight = 478
  end
  object Panel3: TPanel
    Left = 0
    Top = 0
    Width = 674
    Height = 193
    Align = alTop
    Caption = 'Panel3'
    TabOrder = 2
  end
end

---

就截取父窗口消息而言，您的代码工作得非常正确。然而，窗口钩子代码中存在一个问题，这可能会导致您错误地得出这样的结论：测试用例中的一个面板没有按比例调整大小，因此无法正常工作

此代码中存在问题：

  case Align of
    alTop,                   vvvvv
    alBottom : FindControlEx.Width := Round(Parent.Height * FControlRatio);
                             ^^^^^
    alLeft,
    alRight  : FindControlEx.Width := Round(Parent.Width * FControlRatio);
  end;

请注意，在这两种情况下，您都在设置活动控件的宽度。对于顶部对齐的拆分器，您应该设置高度

  case Align of
    alTop,                   vvvvvv
    alBottom : FindControlEx.Height := Round(Parent.Height * FControlRatio);
                             ^^^^^^
    alLeft,
    alRight  : FindControlEx.Width  := Round(Parent.Width * FControlRatio);
  end;

---

这就是为什么您的顶部面板没有调整其高度，即使收到WM\u SIZE消息。

这不是对您问题的回答，但是。我为您的项目创建了一个XE4版本，它工作得非常完美。两个拆分器实例窗口钩子按预期截获消息。要么是XE7中有一些非常奇怪的错误导致这个简单机制失败（不太可能是imho），要么是实际项目中有其他东西导致了问题（很可能是imho）。好的，因此，经过调试，测试了消息捕获，并发现这是可行的，您会很高兴知道我现在已经找到了我认为是您的问题的真正原因。见我的答案。：）啊！这就是睡觉前测试代码时发生的情况。今天早上我发现了另一个小问题。如果有人感兴趣，我稍后会发布完整的工作代码。

  case Align of
    alTop,                   vvvvvv
    alBottom : FindControlEx.Height := Round(Parent.Height * FControlRatio);
                             ^^^^^^
    alLeft,
    alRight  : FindControlEx.Width  := Round(Parent.Width * FControlRatio);
  end;