Delphi TDockZone使用rsUpdate样式调整大小

时间:2016-01-05 06:50:31

标签: delphi docking

我在我的项目中使用TPanels进行对接,我可以在其中停放更多表单。 但是停靠区域只能使用" rsPattern"样式。 我希望他们在" rsUpdate"中重新调整大小。风格。

因为Controls.TDockTree很遗憾地将所有必需的例程私有(不允许在任何TDockTree后代中更改它 - 因为TDockZone.FOrientation只是私有等),我为我的项目制作了Controls.pas的自定义副本并修改了该代码直接

这种方式对我来说已经足够了,因为它按预期工作,但每次Delphi升级我都必须再次更改此代码,对于新的Controls.pas(当它会改变时)。

是否有一些更清洁的方式(当然不使用外部库)?或者你如何解决这些问题?

1 个答案:

答案 0 :(得分:2)

此解决方案基于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;