Delphi 使用 rsUpdate 样式调整 TDockZone 大小

Question

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

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

这种方式对我来说已经足够了，因为它按预期工作，但每次 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;

Delphi 使用 rsUpdate 样式调整 TDockZone 大小

Delphi TDockZone resizing with rsUpdate style

delphi

docking