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

时间:2015-08-20 20:45:59

标签: delphi delphi-xe7 windows-messages splitter

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

子类化
more ./xxx.server

当父母有一个分配器时,这非常有效。但是,当有一个或多个分割器时,只有其中一个可以正常工作。

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

这是我的代码

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

演示.pas

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.

演示.dfm

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.

1 个答案:

答案 0 :(得分:2)

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

问题在于此代码:

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

请注意,在这两种情况下,您都要设置活动控件的 WIDTH 。对于顶部 / 底部对齐的拆分器,您应该设置 HEIGHT

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

这就是为什么你的顶级面板没有调整其高度,即使 WM_SIZE 消息 正在接收。