jvdocktree.pas

East make Tray Icon in delphi

    function GetHTFlag(MousePos: TPoint): Integer; virtual;
    procedure GetSiteInfo(Client: TControl;
      var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); virtual;
    function HitTest(const MousePos: TPoint; out HTFlag: Integer): TControl; virtual;
    function InternalHitTest(const MousePos: TPoint;
      out HTFlag: Integer): TJvDockZone; virtual;
    procedure InsertControl(Control: TControl; InsertAt: TAlign;
      DropCtl: TControl); virtual;
    procedure InsertNewParent(NewZone, SiblingZone: TJvDockZone;
      ParentOrientation: TDockOrientation; InsertLast, Update: Boolean); virtual;
    procedure InsertSibling(NewZone, SiblingZone: TJvDockZone;
      InsertLast, Update: Boolean); virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    procedure PaintDockSite; virtual;
    procedure DrawDockSiteRect; virtual;
    procedure DrawZone(Zone: TJvDockZone); virtual;
    procedure DrawZoneGrabber(Zone: TJvDockZone); virtual;
    procedure DrawDockGrabber(Control: TControl; const ARect: TRect); virtual;
    procedure DrawZoneSplitter(Zone: TJvDockZone); virtual;
    procedure DrawSplitterRect(const ARect: TRect); virtual;
    procedure DrawZoneBorder(Zone: TJvDockZone); virtual;
    procedure DrawDockBorder(DockControl: TControl; R1, R2: TRect); virtual;
    procedure GetCaptionRect(var Rect: TRect); virtual;
    procedure PositionDockRect(Client, DropCtl: TControl;
      DropAlign: TAlign; var DockRect: TRect); virtual;
    procedure PruneZone(Zone: TJvDockZone); virtual;
    procedure RemoveZone(Zone: TJvDockZone; Hide: Boolean = True); virtual;
    procedure ScaleZone(Zone: TJvDockZone); virtual;
    procedure ScaleChildZone(Zone: TJvDockZone); virtual;
    procedure ScaleSiblingZone(Zone: TJvDockZone); virtual;
    procedure ShiftZone(Zone: TJvDockZone); virtual;
    procedure UpdateZone(Zone: TJvDockZone); virtual;
    procedure DrawSplitter(Zone: TJvDockZone); virtual;
    procedure RemoveControl(Control: TControl); virtual;
    procedure SetActiveControl(const Value: TControl); virtual;
    procedure SetGrabberSize(const Value: Integer); virtual;
    procedure SetNewBounds(Zone: TJvDockZone); virtual;
    procedure SetReplacingControl(Control: TControl);
    procedure SplitterMouseDown(OnZone: TJvDockZone; MousePos: TPoint); virtual;
    procedure SplitterMouseUp; virtual;
    procedure ResetBounds(Force: Boolean); virtual;
    procedure WriteControlName(Stream: TStream; const ControlName: string);
    procedure ReadControlName(Stream: TStream; var ControlName: string);
    procedure ShowControl(Control: TControl);
    procedure HideControl(Control: TControl);
    procedure ShowAllControl;
    procedure HideAllControl;
    procedure ShowSingleControl(Control: TControl);
    procedure HideSingleControl(Control: TControl);
    procedure ReplaceZoneChild(OldControl, NewControl: TControl);
    property BorderWidth: Integer read GetBorderWidth write SetBorderWidth;
    property Canvas: TControlCanvas read FCanvas;
    property DockSiteSize: Integer read GetDockSiteSize write SetDockSiteSize;
    property DockSiteSizeAlternate: Integer read GetDockSiteSizeAlternate write SetDockSiteSizeAlternate;
    property DockSiteBegin: Integer read GetDockSiteBegin write SetDockSiteBegin;
    property DockSiteSizeWithOrientation[Orient: TDockOrientation]: Integer
    read GetDockSiteSizeWithOrientation write SetDockSiteSizeWithOrientation;

    property GrabberSize: Integer read FGrabberSize write SetGrabberSize;
    property GrabberShowLines: Boolean read FGrabberShowLines write FGrabberShowLines; {should there be bump-lines to make the grabber look 'grabby'? }
    property GrabberBgColor: TColor read FGrabberBgColor write FGrabberBgColor; // if FGrabberStandardDraw is False, this indicates background color of Grabber. Set to clNone to skip painting the background.
    property GrabberBottomEdgeColor: TColor read FGrabberBottomEdgeColor write FGrabberBottomEdgeColor; // if anything other than clNone, draw a line at bottom edge.

    property GrabbersPosition: TJvDockGrabbersPosition read GetDockGrabbersPosition;
    property MinSize: Integer read GetMinSize write SetMinSize;
    property DockRect: TRect read GetDockRect write SetDockRect;
    property PreviousRect: TRect read FPreviousRect write FPreviousRect;
    property ParentLimit: Integer read FParentLimit write FParentLimit;
    property ReplacementZone: TJvDockZone read FReplacementZone write FReplacementZone;
    property ResizeCount: Integer read FResizeCount write FResizeCount;
    property ScaleBy: Double read FScaleBy write FScaleBy;
    property ShiftBy: Integer read FShiftBy write FShiftBy;
    property ShiftScaleOrientation: TDockOrientation read FShiftScaleOrientation write FShiftScaleOrientation;
    property SizePos: TPoint read FSizePos write FSizePos;
    property SizingDC: HDC read FSizingDC;
    property SizingWnd: HWND read FSizingWnd;
    property SizingZone: TJvDockZone read FSizingZone write FSizingZone;
    property SplitterWidth: Integer read GetDockSplitterWidth write SetDockSplitterWidth;
    property UpdateCount: Integer read FUpdateCount write FUpdateCount;
    property Version: Integer read FVersion write SetVersion;

    {$IFDEF JVDOCK_DEBUG}
    // internal helper functions used recursively from DebugDump:
    procedure _ParentDump(LevelsLeft: Integer; AParent: TWinControl; Indent: string; Strs: TStrings);
    procedure _PageControlDump(PageControl : TWinControl; Indent: string; Strs: TStrings); {actually TJvDockTabPageControl}
    procedure _ControlDump(AControl: TWinControl; Indent: string; Strs: TStrings);
    // This helps us to understand the content of the tree by allowing
    // us to build a dump:
    procedure DebugDump(var Index: Integer; Indent, Entity: string; TreeZone: TJvDockZone; Strs: TStrings); //virtual;
    {$ENDIF JVDOCK_DEBUG}

    {$IFDEF JVDOCK_QUERY}
    procedure _ParentQuery( LevelsLeft:Integer; AParent:TWinControl; FoundItems:TList );
    procedure _PageControlQuery(PageControl : TWinControl; FoundItems:TList); {actually TJvDockTabPageControl}
    procedure _ControlQuery( AControl:TWinControl; FoundItems:TList);
    procedure DoControlQuery(TreeZone: TJvDockZone; FoundItems:TList); //virtual;
    {$ENDIF JVDOCK_QUERY}
  public
    {$IFDEF JVDOCK_DEBUG}
    // A top level call for end user to call, which calls
    // DebugDump in turn:
    procedure Debug(BasePropertyName: string; Strs: TStrings);
    {$ENDIF JVDOCK_DEBUG}
    {$IFDEF JVDOCK_QUERY}
    // Descends the Tree and Finds and return TWinControls docked to a particular parent.
    procedure ControlQuery(DockedTo: TWinControl; FoundItems: TList);
    {$ENDIF JVDOCK_QUERY}
    // (rom) deactivated  completely unused
    // SplitterCanvas: TControlCanvas;
    constructor Create(ADockSite: TWinControl; ADockZoneClass: TJvDockZoneClass; ADockStyle: TComponent {TJvDockBasicStyle}); virtual;
    destructor Destroy; override;
   {$IFDEF JVCL_DOCKING_NOTIFYLISTENERS}
    procedure NotifyDockStyleChange; virtual; // properties in Dock Style (FDockStyle) have changed.
   {$ENDIF JVCL_DOCKING_NOTIFYLISTENERS}
    property DockSite: TWinControl read FDockSite write FDockSite;
    property DockSiteOrientation: TDockOrientation read GetDockSiteOrientation;
    procedure SetSplitterCursor(CursorIndex: TDockOrientation); virtual;
    procedure PaintSite(DC: HDC); virtual;
    property TopXYLimit: Integer read FTopXYLimit write SetTopXYLimit;
    property TopZone: TJvDockZone read FTopZone write SetTopZone; // ROOT NODE!
    procedure UpdateAll;
    procedure UpdateChild(Zone: TJvDockZone);
    property DockZoneClass: TJvDockZoneClass read FDockZoneClass write SetDockZoneClass;
   {$IFDEF JVCL_DOCKING_NOTIFYLISTENERS}
    property DockStyle: TComponent read FDockStyle write FDockStyle; {actual type is TJvDockBasicStyle}  {NEW!}
    property DockStyleListener: Boolean read FDockStyleListener write FDockStyleListener; {if True, we are linked as a listener to this dock style.}
   {$ENDIF JVCL_DOCKING_NOTIFYLISTENERS}
  end;

  TJvDockTreeClass = class of TJvDockTree;

// (rom) made typed const to allow SizeOf
const
  TreeStreamEndFlag: Integer = -1;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDockTree.pas,v $';
    Revision: '$Revision: 1.32 $';
    Date: '$Date: 2005/02/17 10:20:24 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF JVCLThemesEnabled}
  JvThemes,
  {$ENDIF JVCLThemesEnabled}
  Consts, SysUtils, Math,
  JvDockControlForm, JvDockSupportProc, JvDockGlobals, JvDockVSNetStyle,
  JvDockAdvTree;

type
  TWinControlAccessProtected = class(TWinControl);

//=== { TJvDockZone } ========================================================

constructor TJvDockZone.Create(ATree: TJvDockTree);
begin
  ParentZone := nil;
  PrevSibling := nil;
  NextSibling := nil;
  ChildZones := nil;
  ChildControl := nil;
  FTree := ATree;
  FVisibled := True;
end;

function TJvDockZone.GetChildCount: Integer;
var
  Zone: TJvDockZone;
begin
  Result := 0;
  Zone := ChildZones;
  while Zone <> nil do
  begin
    Zone := Zone.NextSibling;
    Inc(Result);
  end;
end;

function TJvDockZone.GetLimitBegin: Integer;
var
  CheckZone: TJvDockZone;
begin
  if FTree.FTopZone = Self then
    CheckZone := Self
  else
    CheckZone := FParentZone;
  if CheckZone.Orientation = doHorizontal then
    Result := Top
  else
  if CheckZone.Orientation = doVertical then
    Result := Left
  else
    Result := 0;
end;

function TJvDockZone.GetLimitSize: Integer;
var
  CheckZone: TJvDockZone;
begin
  if FTree.FTopZone = Self then
    CheckZone := Self
  else
    CheckZone := FParentZone;
  if CheckZone.Orientation = doHorizontal then
    Result := Height
  else
  if CheckZone.Orientation = doVertical then
    Result := Width
  else
    Result := Tree.TopXYLimit;
end;

function TJvDockZone.GetTopLeft(Orient: Integer): Integer;
var
  Zone: TJvDockZone;
  R: TRect;
begin
  Zone := Self;
  while Zone <> FTree.FTopZone do
  begin
    if (Zone.VisiblePrevSiblingCount > 0) and (Zone.ParentZone.Orientation = TDockOrientation(Orient)) then
    begin
      Result := Zone.BeforeClosestVisibleZone.ZoneLimit;
      Exit;
    end
    else
      Zone := Zone.ParentZone;
  end;
  R := FTree.FDockSite.ClientRect;
  TWinControlAccessProtected(FTree.FDockSite).AdjustClientRect(R);
  case TDockOrientation(Orient) of
    doVertical:
      Result := R.Left;
    doHorizontal:
      Result := R.Top;
  else
    Result := 0;
  end;
end;

function TJvDockZone.GetHeightWidth(Orient: Integer): Integer;
var
  Zone: TJvDockZone;
  R: TRect;
begin
  if (Self = FTree.FTopZone) or ((FParentZone = FTree.FTopZone) and
    (ChildControl <> nil) and (FTree.FTopZone.ChildCount = 1)) then
  begin
    R := FTree.FDockSite.ClientRect;
    TWinControlAccessProtected(FTree.FDockSite).AdjustClientRect(R);
    if TDockOrientation(Orient) = doHorizontal then
      Result := R.Bottom - R.Top
    else
      Result := R.Right - R.Left;
  end
  else
  begin
    Zone := Self;
    while (Zone <> FTree.FTopZone) and (Zone.ParentZone <> nil) do
    begin
      if Zone.ParentZone.Orientation = TDockOrientation(Orient) then
      begin
        Result := Zone.ZoneLimit - Zone.LimitBegin;
        Exit;
      end
      else
        Zone := Zone.ParentZone;
    end;
    if FTree.FTopZone.Orientation = TDockOrientation(Orient) then
      Result := FTree.TopXYLimit
    else
      Result := FTree.FTopZone.ZoneLimit;
  end;
end;

procedure TJvDockZone.ResetChildren(Exclude: TJvDockZone);
var
  SumLimit: Integer;
  NewLimit: Integer;
  FirstChildBegin: Integer;
  OldPrevLimit: Integer;
  ChildNode: TJvDockZone;
  PrevNode: TJvDockZone;
begin
  case Orientation of
    doHorizontal:
      NewLimit := Height;
    doVertical:
      NewLimit := Width;
  else
    Exit;
  end;

  ChildNode := FirstVisibleChildZone;
  if ChildNode = nil then
    Exit;

  SumLimit := NewLimit;
  NewLimit := NewLimit div VisibleChildCount;

  FirstChildBegin := ChildNode.LimitBegin;

  Tree.ShiftScaleOrientation := Orientation;
  Tree.ParentLimit := 0;
  if ChildNode.ZoneLimit - FirstChildBegin > 0 then
    Tree.ScaleBy := NewLimit / (ChildNode.ZoneLimit - FirstChildBegin)
  else
    Tree.ScaleBy := 1;
  if (Tree.ScaleBy <> 1) and (ChildNode.VisibleChildCount > 0) then
    Tree.ForEachAt(ChildNode.ChildZones, Tree.ScaleChildZone, tskMiddle, tspChild);

  if ChildNode <> Exclude then
    OldPrevLimit := ChildNode.ZoneLimit
  else
    OldPrevLimit := FirstChildBegin;

  ChildNode.ZoneLimit := FirstChildBegin + NewLimit;
  ChildNode.Update;

  PrevNode := ChildNode;
  ChildNode := ChildNode.AfterClosestVisibleZone;

  while ChildNode <> nil do
  begin
    if ChildNode.ZoneLimit - OldPrevLimit > 0 then
      Tree.ScaleBy := NewLimit / (ChildNode.ZoneLimit - OldPrevLimit)
    else
      Tree.ScaleBy := 1;

    Tree.ShiftBy := PrevNode.ZoneLimit - OldPrevLimit;
    if (Tree.ShiftBy <> 0) and (ChildNode.VisibleChildCount > 0) then
      Tree.ForEachAt(ChildNode.ChildZones, Tree.ShiftZone, tskForward);

    Tree.ParentLimit := PrevNode.ZoneLimit;

    if (Tree.ScaleBy <> 1) and (ChildNode.VisibleChildCount > 0) then
      Tree.ForEachAt(ChildNode.ChildZones, Tree.ScaleChildZone, tskForward);

    if ChildNode <> Exclude then
      OldPrevLimit := ChildNode.ZoneLimit;

    ChildNode.ZoneLimit := PrevNode.ZoneLimit + NewLimit;

    if ChildNode.AfterClosestVisibleZone = nil then
    begin
      if NewLimit = 0 then
        NewLimit := 1;
      ChildNode.ZoneLimit := ChildNode.ZoneLimit + (SumLimit mod NewLimit);
    end;
    ChildNode.Update;
    PrevNode := ChildNode;
    ChildNode := ChildNode.AfterClosestVisibleZone;
  end;
end;

function TJvDockZone.GetControlName: string;
begin
  Result := '';
  if ChildControl <> nil then
  begin
    if ChildControl.Name = '' then
      raise Exception.CreateRes(@SDockedCtlNeedsName);
    Result := ChildControl.Name;
  end;
end;