允许多个子控件检测其父控件何时调整大小

Question

我正在编写一个 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.

演示.pas

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,

  ProportionalSplitterU;

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    FSplitter: TProportionalSplitter;
    FSplitter2: TProportionalSplitter;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  FSplitter := TProportionalSplitter.Create(Self);
  FSplitter.Parent := Self;
  FSplitter.Align := alLeft;
  FSplitter.Left := Panel1.Width + 1;
  FSplitter.Width := 20;
  FSplitter.ResizeStyle := rsUpdate;

  FSplitter2 := TProportionalSplitter.Create(Self);
  FSplitter2.Parent := Self;
  FSplitter2.Align := alTop;
  FSplitter2.Top := Panel3.Height + 1;
  FSplitter2.Height := 20;
  FSplitter2.ResizeStyle := rsUpdate;
end;

end.

演示.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

Answer 1

就拦截父窗口消息而言，您的代码工作正常。但是，您的窗口挂钩代码中存在一个问题，这可能导致您错误地得出结论认为这不起作用，因为您的测试用例中的面板之一没有按比例调整大小。

问题出在这段代码中：

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

请注意，在这两种情况下，您都在设置活动控件的 WIDTH。对于 Top/Bottom 对齐的分隔符，您应该设置 HEIGHT。

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

这就是为什么您的顶部面板没有调整其高度的原因，即使 WM_SIZE 消息 正在接收。