允许多个子控件检测其父控件何时调整大小
Allow multiple child controls to detect when their parent control resizes
我正在编写一个 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
就截取父 window 消息而言,您的代码工作正常。但是,您的 window 挂钩代码中存在一个问题,可能导致您错误地得出结论认为这不起作用,因为您的测试用例中的一个面板没有按比例调整大小。
问题出在这段代码中:
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 消息 也是如此。
我正在编写一个 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
就截取父 window 消息而言,您的代码工作正常。但是,您的 window 挂钩代码中存在一个问题,可能导致您错误地得出结论认为这不起作用,因为您的测试用例中的一个面板没有按比例调整大小。
问题出在这段代码中:
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 消息 也是如此。