jvdocktree.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDockTree.pas, released on 2003-12-31.

The Initial Developer of the Original Code is luxiaoban.
Portions created by luxiaoban are Copyright (C) 2002,2003 luxiaoban.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDockTree.pas,v 1.32 2005/02/17 10:20:24 marquardt Exp $

unit JvDockTree;

{$I jvcl.inc}

{$DEFINE JVDOCK_QUERY} // experimental!

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, Classes, Graphics, Controls, Forms,
  JvDockSupportClass;

type
  TJvDockTree = class;

  IJvDockManager = interface(IDockManager)
    ['{7B0AACBC-E9BF-42F8-9629-E551067090B2}']
    function GetActiveControl: TControl;
    procedure SetActiveControl(const Value: TControl);
    function GetGrabberSize: Integer;
    procedure SetGrabberSize(const Value: Integer);
    function GetDockSplitterWidth: Integer;
    procedure SetDockSplitterWidth(const Value: Integer);
    function GetBorderWidth: Integer;
    procedure SetBorderWidth(const Value: Integer);
    function GetDockRect: TRect;
    procedure SetDockRect(const Value: TRect);
    function GetDockSiteSize: Integer;
    procedure SetDockSiteSize(const Value: Integer);
    function GetMinSize: Integer;
    procedure BeginResizeDockSite;
    procedure EndResizeDockSite;
    function GetDockEdge(DockRect: TRect; MousePos: TPoint;
      var DropAlign: TAlign; Control: TControl): TControl;
    function GetHTFlag(MousePos: TPoint): Integer;
    procedure GetSiteInfo(Client: TControl;
      var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
    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);
    function HasZoneWithControl(Control: TControl): Boolean;
    function GetDockClientLimit(Orient: TDockOrientation; IsMin: Boolean): Integer;
    function GetFrameRect(Control: TControl): TRect;
    function GetFrameRectEx(Control: TControl): TRect;
    property ActiveControl: TControl read GetActiveControl write SetActiveControl;
    property GrabberSize: Integer read GetGrabberSize write SetGrabberSize;
    property SplitterWidth: Integer read GetDockSplitterWidth write SetDockSplitterWidth;
    property BorderWidth: Integer read GetBorderWidth write SetBorderWidth;
    property DockSiteSize: Integer read GetDockSiteSize write SetDockSiteSize;
    property DockRect: TRect read GetDockRect write SetDockRect;
    property MinSize: Integer read GetMinSize;
    //property AlwaysAdjust: Boolean read GetAlwaysAdjust write SetAlwaysAdjust;
  end;

  { Left dock panel with 3 zones; zone 1 contains zone 2 & 3; zone 2 contains
    control A; zone 3 contains control B.
    Right dock panel with 3 zones; zone 4 contains zone 5 & 6; zone 5 contains
    control C; zone 6 contains control D.

                   Zone 1    Zone 2     Zone 3     Zone 4    Zone 5     Zone 6
    -----------------------------------------------------------------------------
    Contains       Zone 2+3  Control A  Control B  Zone 5+6  Control C  Control D
    Orientation    Vertical  No         No         Horiz.    No         No
    ZoneLimit      x2-x0     x1         x2         x4-x3     y1         y2
    LimitBegin     x0        x0         x1         y0        y0         y1
    LimitSize      x2-x0     x1-x0      x2-x0      y2-y0     y1-y0      y2-y1

                                 y0
     --------------------------/
     |   |   |         |     |
     |   |   |         |  C  |
     |   |   |         |     |   y1
     | A | B |         |-----|-/
     |   |   |         |     |
     |   |   |         |  D  |
     |   |   |         |     |   y2
     |---|---|---------|-----|-/
     \   \   \         \     \
      x0  x1  x2        x3    x4
  }
  
  TJvDockZone = class(TObject)
  private
    FChildControl: TWinControl;
    FChildZones: TJvDockZone;
    FNextSibling: TJvDockZone;
    FOrientation: TDockOrientation;
    FParentZone: TJvDockZone;
    FPrevSibling: TJvDockZone;
    FTree: TJvDockTree; { Owner }
    FZoneLimit: Integer;
    FVisibleSize: Integer;
    FVisibled: Boolean;
    FControlVisibled: Boolean;
    FIsInside: Boolean;
    function GetFirstSibling: TJvDockZone;
    function GetLastSibling: TJvDockZone;
    function GetFirstChild: TJvDockZone;
    function GetLastChild: TJvDockZone;
    function GetTopLeftArr(Orient: TDockOrientation): Integer;
    function GetHeightWidthArr(Orient: TDockOrientation): Integer;
    function GetAfterClosestVisibleZone: TJvDockZone;
    function GetBeforeClosestVisibleZone: TJvDockZone;
    function GetAfterApoapsisVisibleZone: TJvDockZone;
    function GetBeforeApoapsisVisibleZone: TJvDockZone;
    function GetNextSiblingCount: Integer;
    function GetPrevSiblingCount: Integer;
    procedure SetVisibled(const Value: Boolean);
    procedure SetZoneLimit(const Value: Integer);
    function GetVisibleNextSiblingCount: Integer;
    function GetVisibleNextSiblingTotal: Integer;
    function GetVisiblePrevSiblingCount: Integer;
    function GetVisiblePrevSiblingTotal: Integer;
    function GetFirstVisibleChildZone: TJvDockZone;
    function GetLastVisibleChildZone: TJvDockZone;
    procedure SetIsInside(const Value: Boolean);
  protected
    procedure AdjustZoneLimit(Value: Integer); virtual;
    procedure LButtonDblClkMethod; virtual;
    function GetChildCount: Integer;
    function GetVisibleChildCount: Integer;
    function GetChildTotal: Integer;
    function GetVisibleChildTotal: Integer;
    function GetLimitBegin: Integer;
    function GetLimitSize: Integer;
    function GetTopLeft(Orient: Integer): Integer;
    function GetHeightWidth(Orient: Integer): Integer;
    function GetControlName: string;
    function GetSplitterLimit(IsMin: Boolean): Integer; virtual;
    function DoGetSplitterLimit(Orientation: TDockOrientation;
      IsMin: Boolean; var LimitResult: Integer): Integer; virtual;
    function SetControlName(const Value: string): Boolean;
    procedure DoCustomSetControlName; virtual;
    procedure SetChildControlVisible(Client: TControl; AVisible: Boolean); virtual;
  public
    constructor Create(ATree: TJvDockTree); virtual;
    procedure Insert(DockSize: Integer; Hide: Boolean); virtual;
    procedure Remove(DockSize: Integer; Hide: Boolean); virtual;
    procedure InsertOrRemove(DockSize: Integer; Insert: Boolean; Hide: Boolean); virtual;
    procedure ResetChildren(Exclude: TJvDockZone); virtual;
    procedure Update; virtual;
    function GetFrameRect: TRect; virtual;
    procedure SetZoneSize(Size: Integer; Show: Boolean); virtual;
    property BeforeClosestVisibleZone: TJvDockZone read GetBeforeClosestVisibleZone;
    property AfterClosestVisibleZone: TJvDockZone read GetAfterClosestVisibleZone;
    property BeforeApoapsisVisibleZone: TJvDockZone read GetBeforeApoapsisVisibleZone;
    property AfterApoapsisVisibleZone: TJvDockZone read GetAfterApoapsisVisibleZone;
    property FirstVisibleChildZone: TJvDockZone read GetFirstVisibleChildZone;
    property LastVisibleChildZone: TJvDockZone read GetLastVisibleChildZone;
    property ChildCount: Integer read GetChildCount;
    property ChildTotal: Integer read GetChildTotal;
    property ChildZones: TJvDockZone read FChildZones write FChildZones;
    property ChildControl: TWinControl read FChildControl write FChildControl;
    property FirstChild: TJvDockZone read GetFirstChild;
    property FirstSibling: TJvDockZone read GetFirstSibling;
    property Height: Integer index Ord(doHorizontal) read GetHeightWidth;
    property HeightWidth[Orient: TDockOrientation]: Integer read GetHeightWidthArr;
    property LastChild: TJvDockZone read GetLastChild;
    property LastSibling: TJvDockZone read GetLastSibling;
    property Left: Integer index Ord(doVertical) read GetTopLeft;
    property LimitBegin: Integer read GetLimitBegin;
    property LimitSize: Integer read GetLimitSize;
    property NextSibling: TJvDockZone read FNextSibling write FNextSibling;
    property NextSiblingCount: Integer read GetNextSiblingCount;
    property Orientation: TDockOrientation read FOrientation write FOrientation;
    property ParentZone: TJvDockZone read FParentZone write FParentZone;
    property PrevSibling: TJvDockZone read FPrevSibling write FPrevSibling;
    property PrevSiblingCount: Integer read GetPrevSiblingCount;
    property Top: Integer index Ord(doHorizontal) read GetTopLeft;
    property TopLeft[Orient: TDockOrientation]: Integer read GetTopLeftArr;
    property Tree: TJvDockTree read FTree;
    property VisibleChildCount: Integer read GetVisibleChildCount;
    property VisibleChildTotal: Integer read GetVisibleChildTotal;
    property VisiblePrevSiblingCount: Integer read GetVisiblePrevSiblingCount;
    property VisiblePrevSiblingTotal: Integer read GetVisiblePrevSiblingTotal;
    property VisibleNextSiblingCount: Integer read GetVisibleNextSiblingCount;
    property VisibleNextSiblingTotal: Integer read GetVisibleNextSiblingTotal;
    property VisibleSize: Integer read FVisibleSize write FVisibleSize;
    property Width: Integer index Ord(doVertical) read GetHeightWidth;
    property ZoneLimit: Integer read FZoneLimit write SetZoneLimit;
    property Visibled: Boolean read FVisibled write SetVisibled;
    property IsInside: Boolean read FIsInside write SetIsInside;
  end;

  TJvDockAdvZone = class(TJvDockZone)
  private
    FCloseBtnDown: Boolean;
    FMouseDown: Boolean;
  protected
    procedure LButtonDblClkMethod; override;
  public
    constructor Create(ATree: TJvDockTree); override;
    destructor Destroy; override;
    procedure Insert(DockSize: Integer; Hide: Boolean); override;
    procedure Remove(DockSize: Integer; Hide: Boolean); override;
    property CloseBtnDown: Boolean read FCloseBtnDown write FCloseBtnDown;
    property MouseDown: Boolean read FMouseDown write FMouseDown;
  end;

  TJvDockTreeScanKind = (tskForward, tskMiddle, tskBackward);
  TJvDockTreeScanPriority = (tspSibling, tspChild);
  TJvDockGrabbersPosition = (gpTop, gpBottom, gpLeft, gpRight);
  TJvDockForEachZoneProc = procedure(Zone: TJvDockZone) of object;
  TJvDockZoneClass = class of TJvDockZone;

  TJvDockTree = class(TInterfacedObject, IJvDockManager)
  private
    FDockZoneClass: TJvDockZoneClass;
    FActiveControl: TControl;
    FBorderWidth: Integer;
    FSplitterWidth: Integer;
    FBrush: TBrush;
    FDockSite: TWinControl;
    FPreviousRect: TRect;
    FDockRect: TRect;
    FOldWndProc: TWndMethod;
    FReplacementZone: TJvDockZone;
    FResizeCount: Integer;
    FScaleBy: Double;
    FShiftScaleOrientation: TDockOrientation;
    FShiftBy: Integer;
    FSizePos: TPoint;
    FSizingDC: HDC;
    FSizingWnd: HWND;
    FSizingZone: TJvDockZone;
    FTopZone: TJvDockZone; // <-- Root Node of the tree. What is called Zone in here should really be called TreeNode.
    FTopXYLimit: Integer;
    FUpdateCount: Integer;
    FVersion: Integer;
    FOldHTFlag: Integer;
    FParentLimit: Integer;
    FMinSize: Integer;
    FCanvas: TControlCanvas;
    {$IFDEF JVCL_DOCKING_NOTIFYLISTENERS}
    FDockStyle: TComponent; {FUTURE: actual type is TJvDockBasicStyle}  {NEW!}
    FDockStyleListener: Boolean; {FUTURE:if True, we are linked as a listener to this dock style.}
    {$ENDIF JVCL_DOCKING_NOTIFYLISTENERS}
    FGrabberSize: Integer; { size of grabber }
    FGrabberShowLines: Boolean; {should there be bump-lines to make the grabber look 'grabby'? }
    FGrabberBgColor: TColor; // if FGrabberStandardDraw is False, this indicates background color of Grabber.
    FGrabberBottomEdgeColor: TColor; // if anything other than clNone, draw a line at bottom edge.
    procedure SetTopZone(const Value: TJvDockZone);
    procedure SetTopXYLimit(const Value: Integer);
    procedure SetDockZoneClass(const Value: TJvDockZoneClass);
    function GetDockSplitterWidth: Integer;
    function GetBorderWidth: Integer;
    procedure SetDockSplitterWidth(const Value: Integer);
    procedure SetBorderWidth(const Value: Integer);
    function GetDockSiteOrientation: TDockOrientation;
    function GetDockSiteSize: Integer;
    procedure SetDockSiteSize(const Value: Integer);
    procedure SetMinSize(const Value: Integer);
    function GetDockSiteBegin: Integer;
    procedure SetDockSiteBegin(const Value: Integer);
    function GetDockSiteSizeAlternate: Integer;
    procedure SetDockSiteSizeAlternate(const Value: Integer);
    procedure SetVersion(const Value: Integer);
    function GetDockSiteSizeWithOrientation(Orient: TDockOrientation): Integer;
    procedure SetDockSiteSizeWithOrientation(Orient: TDockOrientation; const Value: Integer);
    function GetDockRect: TRect;
    procedure SetDockRect(const Value: TRect);
    function GetMinSize: Integer;
    function HasZoneWithControl(Control: TControl): Boolean;
   protected
    procedure WindowProc(var Msg: TMessage); virtual;
    procedure BeginDrag(Control: TControl;
      Immediate: Boolean; Threshold: Integer = -1); virtual;
    function DoMouseEvent(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer): TWMNCHitMessage; virtual;
    procedure DoMouseMove(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    function DoLButtonDown(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer): Boolean; virtual;
    procedure DoLButtonUp(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoLButtonDbClk(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoMButtonDown(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoMButtonUp(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoMButtonDbClk(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoRButtonDown(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoRButtonUp(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoRButtonDbClk(var Msg: TWMMouse;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoHideZoneChild(AZone: TJvDockZone); virtual;
    procedure DoSetCursor(var Msg: TWMSetCursor;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoHintShow(var Msg: TCMHintShow;
      var Zone: TJvDockZone; out HTFlag: Integer); virtual;
    procedure DoOtherHint(Zone: TJvDockZone;
      HTFlag: Integer; var HintStr: string); virtual;
    procedure CustomSaveZone(Stream: TStream;
      Zone: TJvDockZone); virtual;
    procedure CustomLoadZone(Stream: TStream;
      var Zone: TJvDockZone); virtual;
    procedure DoSaveZone(Stream: TStream;
      Zone: TJvDockZone; Level: Integer); virtual;
    procedure DoLoadZone(Stream: TStream); virtual;
    procedure AdjustDockRect(Control: TControl; var ARect: TRect); virtual;
    procedure BeginResizeDockSite;
    procedure BeginUpdate;
    procedure CalcSplitterPos; virtual;
    procedure ControlVisibilityChanged(Control: TControl; Visible: Boolean); virtual;
    function GetDockAlign(Client: TControl; var DropCtl: TControl): TAlign; virtual;
    function DoFindZone(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; virtual;
    procedure DrawSizeSplitter; virtual;
    procedure EndResizeDockSite;
    procedure EndUpdate;
    function FindControlZone(Control: TControl; IncludeHide: Boolean = False): TJvDockZone; virtual;
    function FindControlZoneAndLevel(Control: TControl;
      var CtlLevel: Integer; IncludeHide: Boolean = False): TJvDockZone; virtual;
    procedure ForEachAt(Zone: TJvDockZone; Proc: TJvDockForEachZoneProc;
      ScanKind: TJvDockTreeScanKind = tskForward; ScanPriority: TJvDockTreeScanPriority = tspSibling); virtual;
    function GetActiveControl: TControl; virtual;
    function GetGrabberSize: Integer; virtual;
    function GetBorderHTFlag(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; virtual;
    function GetLeftGrabbersHTFlag(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; virtual;
    function GetRightGrabbersHTFlag(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; virtual;
    function GetTopGrabbersHTFlag(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; virtual;
    function GetBottomGrabbersHTFlag(const MousePos: TPoint;
      out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; virtual;
    function GetDockEdge(DockRect: TRect; MousePos: TPoint;
      var DropAlign: TAlign; Control: TControl): TControl; virtual;
    function GetDockClientLimit(Orient: TDockOrientation; IsMin: Boolean): Integer; virtual;
    function GetFrameRect(Control: TControl): TRect; virtual;
    function GetFrameRectEx(Control: TControl): TRect; virtual;
    function GetSplitterRect(Zone: TJvDockZone): TRect; virtual;
    function GetDockGrabbersPosition: TJvDockGrabbersPosition; virtual;
    procedure GetControlBounds(Control: TControl; out CtlBounds: TRect); virtual;
    function GetSplitterLimit(AZone: TJvDockZone; IsCurrent, IsMin: Boolean): Integer; virtual;
    procedure DoGetNextLimit(Zone, AZone: TJvDockZone; var LimitResult: Integer); virtual;