Search code examples
delphidelphi-xe7windows-messagessplitter

Allow multiple child controls to detect when their parent control resizes


I'm writing a TSplitter descendant that proportionally resizes its aligned control when its parent control resizes. In order to detect the parent resize I subclass the parents WinProc procedure

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

This works perfectly when there is a single splitter parented by the parent. However, when there are one or more splitters, only one of them works correctly.

How can I receive a notification to all the splitter controls that the parent has resized?

Here's my code

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

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

Solution

  • You code is working perfectly correctly as far as intercepting parent window messages is concerned. There is however a problem in your window hook code which may have lead you to incorrectly conclude that this was not working as one of your panels in your test case was not being proportionally resized.

    The problem is in this code:

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

    Notice that in both cases you are setting the WIDTH of the active control. For Top/Bottom aligned splitter you should instead be setting the HEIGHT.

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

    This is why your top panel was not resizing its height, even though the WM_SIZE message is being received.