teetree.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

    FSelected   : Boolean;    // When True, this node is Selected.

    procedure CanvasChanged(Sender:TObject); override;
    procedure ChangeAutoSize(Value:Boolean);
    Procedure DoClick(Button:TMouseButton; Shift:TShiftState; x,y:Integer); dynamic;
    procedure DoDrawHandle( Handle:TTreeShapeHandle;
                            var x,y:Integer; var Draw:Boolean); dynamic;
    Procedure DrawGradient(Const Rect:TRect; ACanvas:TCanvas3D);
    Procedure DrawImage;
    procedure DrawShape(Const R:TRect);
    procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); virtual;
    procedure DrawSelectionFocus;
    procedure DrawText(ACanvas:TCanvas3D; Var R:TRect);
    Procedure RecalcImageSize;
    Function GetBrush:TTreeShapeBrush;
    Procedure GetConnectionTo(Const pX0,pY0,pX1,pY1:Integer;
                              Var AX,AY:Integer); dynamic;
    Function GetEditedShape:TTreeNodeShape; dynamic;
    Function GetHandleCursor(x,y:Integer):TCursor; dynamic;
    Function GetRoundRectanglePoints(R:TRect; Var P:TShapePoints):Integer;
    Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; virtual;
    Procedure PictureChanged(Sender:TObject);
    Function RectTo3DCanvas(ACanvas:TCanvas3D; Const R:TRect):TRect;
    Procedure SetBounds(Const R:TRect);
    Procedure SetCanvasFont(ACanvas:TCanvas3D);
    procedure SetImage(const Value:TTreePicture);
    Procedure SetSelected(Value:Boolean); virtual;
    Procedure SetTree(Value:TCustomTree); override;
    Function ShouldDrawCross:Boolean;

    { Parent - Child }
    Function AutoPositionLeft:Boolean;
    Function AutoPositionTop:Boolean;
    Function DoExpandCollapse(Value:Boolean):Integer;
    Procedure DoMouseEnter(Shift: TShiftState; X, Y: Integer);
    Procedure DoMouseLeave(Shift: TShiftState; X, Y: Integer);
    Procedure DoMouseMove(Shift: TShiftState; X, Y: Integer);
    Function RecursiveCountExpanded:Integer;
  public
    Constructor Create(AOwner : TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Procedure AssignFormat(ANode:TTreeNodeShape);

    property AdjustedRectangle:TRect read {FAdjustedRect}GetAdjustedRectangle; // total bounds
    Function Bounds:TRect;
    procedure Clear;
    Function Clicked(x,y:Integer):Boolean; virtual;
    Function ClickedImage(x,y:Integer):Boolean;
    procedure Collapse(Recursive:Boolean);
    Function Count:Integer;
    procedure Draw; virtual;
    Procedure DrawHandles; override;
    Procedure GetConnectionPos(AShape:TTreeNodeShape; Var AX,AY:Integer);
    Function GetImage:TTreePicture;
    Function GetPicture:TPicture;
    Function GetResizingHandle(x,y:Integer):TTreeShapeHandle; dynamic;
    Function InsideTreeBounds:Boolean;
    Procedure RecalcSize(ACanvas:TCanvas3D); virtual;
    Function XCenter:Integer;
    Function YCenter:Integer;

    { Parent - Child }
    Function Add(Const AText:String):TTreeNodeShape; // same as AddChild (alias)
    Function AddBrother(Const AText:String):TTreeNodeShape;
    Function AddChild(Const AText:String):TTreeNodeShape;
    Function AddChildObject(Const AText:String; Data:{$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF}):TTreeNodeShape;
    Function AddConnection( AToShape:TTreeNodeShape ):TTreeConnection;
    Function AddConnectionObject( AToShape:TTreeNodeShape; Data:{$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF} ):TTreeConnection;

    Procedure BringToFront;
    Function CalcXYCross(AParent:TTreeNodeShape):TPoint;
    Function Checked:Boolean; // true if the Image is a checked checkbox
    Function CrossBoxClicked(x,y:Integer):Boolean;
    Function HasChilds:Boolean;
    Function HasChildren:Boolean;

    Function Level:Integer;

    Function MaxHeightExpandedChilds:Integer;
    Function MinHeightExpandedChilds:Integer;
    Procedure MoveRelative(OfsX,OfsY:Integer; MoveChilds:Boolean); dynamic;
    Function DoDraw:Boolean;

    Function Insert(Index:Integer; Const AText:String):TTreeNodeShape;

    Procedure ReCalcPositions(ABrotherIndex:Integer);
    Procedure Resize(ACorner:TTreeShapeHandle; DeltaX,DeltaY:Integer); dynamic;
    Procedure SaveToTextFile(Const FileName:String);
    Procedure SelectChilds;
    Procedure SendToBack;
    procedure SortChildsText(AscendingOrder,IgnoreCase:Boolean);
    procedure Toogle; // expands or collapses the node

    { public properties }
    property BrotherIndex:Integer read GetBrotherIndex{FBrotherIndex} write SetBrotherIndex;
    property Children:TTreeChildrenList read GetChildNodes{FChildren};
    property Childs:TTreeChildrenList read GetChildNodes{FChildren};  // Obsolete (use: Children)
    property Connections:TNodeConnectionList read GetConnections;
    property Parents:TNodeShapeList read GetParents;
    property PreviousBrother:TTreeNodeShape read GetPreviousBrother;
    property Root:TTreeNodeShape read GetRoot;
    property Selected:Boolean read GetSelected{FSelected} write SetSelected default False;


    property Height:Integer read GetHeight write SetHeight;
    property ImageRect:TRect read GetImageRect{FImageRect};
    property Left:Integer read {FX0}GetX0 write SetLeft; // alias of X0
    property Top:Integer read {FY0}GetY0 write SetTop;   // alias of Y0
    property Width:Integer read GetWidth write SetWidth;

  published
    property AutoPosition:TTreeShapeAutoPosition read GetAutoPosition
                                                 write SetAutoPosition;
    property AutoSize:Boolean read GetAutoSize{FAutoSize} write SetAutoSize default True;
    property BackColor:TColor read GetBackColor{FBackColor} write SetBackColor default clNone;
    property Border:TTreePen read GetBorder write SetBorder stored IsBorderStored;
    property Brush:TTreeShapeBrush read GetBrush write SetBrush stored IsBrushStored;
    property Color:TColor read GetColor write SetColor default clWhite;
    property Gradient:TShapeGradient read GetGradient write SetGradient stored IsGradientStored;
    property GradientClip:Boolean read GetGradientClip{FGradientClip} write SetGradientClip
                                  default True;

    property Image:TTreePicture read GetImage write SetImage stored IsImageStored;
    property ImageAlignment:TTreeImageAlignment read GetImageAlignment{FImageAlignment}
                                               write SetImageAlignment
                                               default iaAutomatic;
    property ImageHeight:Integer read GetImageHeight {FImageHeight} write SetImageHeight
                                 default 0;
    property ImageWidth:Integer read GetImageWidth {FImageWidth} write SetImageWidth
                                default 0;
    property Shadow:TTeeShadow read GetShadow write SetShadow stored IsShadowStored;
    property Style:TTreeShapeStyle read GetStyle{FStyle} write SetStyle default tssRectangle;
    property Transparency:TTeeTransparency read GetTransparency{FTransparency}
                                           write SetTransparency default 0;
    property Transparent:Boolean read GetTransparent{FTransparent} write SetTransparent default False;
    property Visible:Boolean read GetVisible{FVisible} write SetVisible default True;
    property X0:Integer read {FX0}GetX0 write SetX0 stored IsPositionLeftStored;  
    property X1:Integer read GetX1 write SetX1 stored IsSizeStored;
    property Y0:Integer read {FY0}GetY0 write SetY0 stored IsPositionTopStored;  
    property Y1:Integer read GetY1 write SetY1 stored IsSizeStored;

    property Cursor;
    property Font;
    property Expanded:Boolean read GetExpanded{FExpanded} write SetExpanded default False;
    property ImageIndex:TTreeNodeImageIndex read GetImageIndex{FImageIndex} write SetImageIndex
             stored IsImageIndexStored;
    property ImageListIndex:Integer read GetImageListIndex{FImageListIndex} write SetImageListIndex
             default -1;
    property Parent:TTreeNodeShape read {FParent}GetParent write SetParent;   
    property ShowCross:TTreeNodeShapeShowCross read GetShowCross{FShowCross} write SetShowCross
                                 default scAuto;
    property Text;

    { events }
    property OnClick    :TClickShapeEvent read FOnClick write FOnClick;
    property OnDblClick :TClickShapeEvent read FOnDblClick write FOnDblClick;
    property OnMouseEnter:TMouseShapeEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave:TMouseShapeEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseMove:TMouseShapeEvent read FOnMouseMove write FOnMouseMove;
  end;

  TExpandingCollapsingEvent=procedure(Sender:TTreeNodeShape; Var Expand:Boolean) of object;

  // Drawing styles for Connection arrows
  TConnectionArrowStyle=( casNone,casSolid,casLines,
                          casSquare,casCircle,casDiamond);

  // Brush with default color Black
  TConnectionArrowBrush=class(TTreeBrush)
  published
    property Color default clBlack;
  end;

  // Several ways to specify the connection points coordinates.
  TConnectionPointStyle=
     ( cpsAutoFrom,       // Automatic position on the "From" node
       cpsAutoTo,         // Automatic position on the "To" node
       cpsFromPercent,    // + / - percent on "From" size
       cpsToPercent,      // + / - percent on "To" size
       cpsFromRel,        // + / - pixels relative from "From" node origin
       cpsToRel,          // + / - pixels relative from "To" node origin
       cpsPrevious,       // + / - pixels relative to Previous Point in array
       cpsNext,           // + / - pixels relative to Next Point array
       cpsFixed           // Fixed XY pixel position
     );

  // Record containing coordinates and styles for each Connection point
  TConnectionPoint=packed record
    XStyle : TConnectionPointStyle;
    YStyle : TConnectionPointStyle;

    XValue : Integer;  // Value to use when calculating X using XStyle
    YValue : Integer;  // Value to use when calculating Y using YStyle

    X      : Integer;  // real X pixel position
    Y      : Integer;  // real Y pixel position
  end;

  // Dynamic Array of Connection points
  TConnectionPointArray=array{$IFNDEF D4}[0..15]{$ENDIF} of TConnectionPoint;

  // Connection points object.
  TConnectionPoints=class
  private
    IConnection : TTreeConnection;
    procedure RemoveAuto;
  public
    Item : TConnectionPointArray;
    Function Add(Const P:TPoint): Integer; overload;
    Function Add(Ax,Ay:Integer):Integer; overload;
    Function Add( AXStyle:TConnectionPointStyle; Ax:Integer;
                  AYStyle:TConnectionPointStyle; Ay: Integer): Integer; overload;
    Function AddFromPrevious(XOffset,YOffset:Integer):Integer;
    Procedure CalculatePosition(Index:Integer);
    Procedure ChangeXStyle(Index:Integer; AStyle:TConnectionPointStyle);
    Procedure ChangeYStyle(Index:Integer; AStyle:TConnectionPointStyle);
    Procedure Clear;
    Function Clicked(x,y:Integer):Integer;
    Function Count:Integer;
    Procedure Delete(Index:Integer);
    Procedure Insert(Index:Integer; x,y:Integer);
    Procedure Move(Index:Integer; DeltaX,DeltaY:Integer);

    { default array property cant be added (dyn array reference, OPascal limitation) }
  end;

  // Visual "arrow" optionally displayed at start / end connection points
  TConnectionArrow=class(TPersistent)
  private
    FBackColor : TColor;
    FBorder    : TTreePen;
    FBrush     : TConnectionArrowBrush;
    FSize      : Integer;
    FStyle     : TConnectionArrowStyle;

    IOwner     : TTreeConnection;
    Function GetBorder:TTreePen;
    Function GetBrush:TConnectionArrowBrush;
    Procedure SetBorder(Value:TTreePen);
    Procedure SetBrush(Value:TConnectionArrowBrush);
    Procedure SetSize(Value:Integer);
    Procedure SetStyle(Value:TConnectionArrowStyle);
    procedure SetBackColor(const Value: TColor);
  public
    Constructor Create(AOwner : TTreeConnection); virtual;
    Destructor Destroy; override;
    Procedure Assign(Source:TPersistent); override;
    Procedure Draw(Const Point:TConnectionPoint; Angle:Integer);
  published
    property BackColor:TColor read FBackColor write SetBackColor default clNone;
    property Border:TTreePen read GetBorder write SetBorder;
    property Brush:TConnectionArrowBrush read GetBrush write SetBrush;
    property Size:Integer read FSize write SetSize default TeeDefaultArrowSize;
    property Style:TConnectionArrowStyle read FStyle write SetStyle;
  end;

  // The "start" (From) connection arrow is hidden by default
  TConnectionArrowFrom=class(TConnectionArrow)
  published
    property Style default casNone;
  end;

  // The "end" (To) connection arrow is solid by default
  TConnectionArrowTo=class(TConnectionArrow)
  published
    property Style default casSolid;
  end;

  // Connection styles.
  // When the style is "auto", the ChildManager class calculates the
  // connection points.
  TTreeConnectionStyle=(csAuto, csLine, csSides, csCurve, csInvertedSides);

  // Default connection line pen is gray color and small dots.
  TTreeConnectionPen=class(TTreePen)
  public
    Constructor Create(OnChangeEvent:TNotifyEvent);
  published
    property Color default clGray;
    property SmallDots default True;
    property Style default psDot;
  end;

  TCurvePoints=Array[0..99] of TPoint; // static array for curved connections

  // Connection object.
  // Connections draw single or multi line segments between nodes
  TTreeConnection=class(TCustomTreeElement)
  private
    FArrowFrom : TConnectionArrowFrom;
    FArrowTo   : TConnectionArrowTo;
    FBorder    : TTreeConnectionPen;
    FPoints    : TConnectionPoints;  // Warning: Future versions might change.
    FStyle     : TTreeConnectionStyle;
    FFromShape : TTreeNodeShape;
    FToShape   : TTreeNodeShape;

    Function GetArrowFrom:TConnectionArrowFrom;
    Function GetArrowTo:TConnectionArrowTo;
    Function GetBorder:TTreeConnectionPen;
    Function GetFromShape:TTreeNodeShape;       
    Function GetPoints:TConnectionPoints;       
    Function GetStyle:TTreeConnectionStyle;     
    Function GetToShape:TTreeNodeShape;         
    Function InternalArrowFrom:TConnectionArrow;
    Function InternalArrowTo:TConnectionArrowTo;
    procedure ReadPoints(Reader: TReader);
    procedure SavePoints(Writer: TWriter);
    procedure SetArrowFrom(const Value:TConnectionArrowFrom);
    procedure SetArrowTo(const Value:TConnectionArrowTo);
    procedure SetBorder(const Value : TTreeConnectionPen);
    procedure SetFromShape(const Value:TTreeNodeShape);
    Procedure SetStyle(const Value:TTreeConnectionStyle);