Изменение размера Delphi TDockZone с помощью стиля rsUpdate

Я использую TPanels для стыковки в своем проекте, где я могу стыковать больше форм. Но размеры стыковочных зон изменяются только в стиле "rsPattern". Я хочу, чтобы они изменялись в стиле «rsUpdate».

Поскольку Controls.TDockTree, к сожалению, имеет все необходимые подпрограммы закрытыми (не позволяя изменить это в любом потомке TDockTree - потому что TDockZone.FOOrientation является только закрытым и т. д.), я сделал собственную копию Controls.pas для своего проекта и изменил этот код напрямую.

Этого способа мне достаточно, потому что он работает, как и ожидалось, но с каждым обновлением Delphi мне приходится снова менять этот код для нового Controls.pas (когда он будет меняться).

Есть ли какой-то более чистый способ (конечно, без использования внешних библиотек)? Или как вы решаете такие проблемы?


delphi docking
person tk_    schedule 05.01.2016    source источник
comment
Вы можете использовать помощник класса для доступа к закрытым полям.   -  person Z.B.    schedule 05.01.2016
comment
Просто добавьте к нему префикс Self в реализации метода в вашем помощнике класса.   -  person Z.B.    schedule 05.01.2016
comment
Работает отлично, спасибо!   -  person tk_    schedule 05.01.2016

Ответы (1)


arrow_upward
2
arrow_downward

Это решение основано на полезной подсказке 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;
person tk_    schedule 05.01.2016