Delphi TDockZone 使用 rsUpdate 样式调整大小

Question

我在我的项目中使用 TPanels 进行对接，我可以在其中对接更多的表单。
但停靠区仅使用“rsPattern”样式调整大小。
我希望他们以“rsUpdate”样式调整大小。

因为 Controls.TDockTree 不幸的是所有必要的例程都是私有(private)的(不允许在任何 TDockTree 后代中更改它 - 因为 TDockZone.FOrientation 只是私有(private)的等等)，所以我为我的项目制作了 Controls.pas 的自定义副本并直接修改了该代码。

这种方式对我来说就足够了，因为它可以按预期工作，但是每次 Delphi 升级我都必须再次更改此代码，以获取新的 Controls.pas(何时更改)。

有没有更清洁的方法(当然不使用外部库)？或者你如何解决这些问题？

Answer 1

此解决方案基于 ZENsan 的有用提示并扩展 CaptionedDockTree.pas(在 Delphi XE 中测试):

type
  TDockZoneHelper = class helper for TDockZone
  private
    function GetOrientation: TDockOrientation;
    function GetParentZone: TDockZone;
  public
    property ParentZone: TDockZone read GetParentZone;
    property Orientation: TDockOrientation read GetOrientation;
  end;

  TDockTreeHelper = class helper for TDockTree
  private
    function GetBorderWidth: Integer;
  protected
    procedure HlpForEachAt(Zone: TDockZone; Proc: TForEachZoneProc);
    function HlpInternalHitTest(const MousePos: TPoint; out HTFlag: Integer): TDockZone;
    procedure HlpSetNewBounds(Zone: TDockZone);
    procedure HlpUpdateZone(Zone: TDockZone);
  public
    property BorderWidth: Integer read GetBorderWidth;
  end;

{ TDockZoneHelper }

function TDockZoneHelper.GetOrientation: TDockOrientation;
begin
  Result := Self.FOrientation;
end;

function TDockZoneHelper.GetParentZone: TDockZone;
begin
  Result := Self.FParentZone;
end;

{ TDockTreeHelper }

procedure TDockTreeHelper.HlpForEachAt(Zone: TDockZone; Proc: TForEachZoneProc);
begin
  Self.ForEachAt(Zone, Proc);
end;

function TDockTreeHelper.GetBorderWidth: Integer;
begin
  Result := Self.FBorderWidth;
end;

function TDockTreeHelper.HlpInternalHitTest(const MousePos: TPoint;
  out HTFlag: Integer): TDockZone;
begin
  Result := Self.InternalHitTest(MousePos, HTFlag);
end;

procedure TDockTreeHelper.HlpSetNewBounds(Zone: TDockZone);
begin
  Self.SetNewBounds(Zone);
end;

procedure TDockTreeHelper.HlpUpdateZone(Zone: TDockZone);
begin
  Self.UpdateZone(Zone);
end;


{ TMyCaptionedDockTree additions }

procedure TMyCaptionedDockTree.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer; var Handled: Boolean);
var
  Zone: TDockZone;
  Flag: Integer;
begin
  FSizingZone := nil;
  if (Button = mbLeft) and not (ssDouble in Shift) then
  begin
    FSizingPoint := Point(X, Y);
    Zone := HlpInternalHitTest(FSizingPoint, Flag);
    if Flag = HTBORDER then
      FSizingZone := Zone;
    else
      inherited;
  end else
    inherited;
end;

procedure TMyCaptionedDockTree.MouseMove(Shift: TShiftState; X, Y: Integer;
  var Handled: Boolean);
begin
  if FSizingZone <> nil then
  begin
    FSizingPoint := Point(X, Y);
    if FSizingZone.ParentZone.Orientation = doHorizontal then
      FSizingZone.ZoneLimit := FSizingPoint.y + (BorderWidth div 2)
    else
      FSizingZone.ZoneLimit := FSizingPoint.x + (BorderWidth div 2);
    HlpSetNewBounds(FSizingZone.ParentZone);
    HlpForEachAt(FSizingZone.ParentZone, HlpUpdateZone);
  end else
    inherited;
end;

procedure TMyCaptionedDockTree.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer; var Handled: Boolean);
begin
  inherited;
  FSizingZone := nil;
end;