teetree.pas

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

    procedure SetToShape(const Value:TTreeNodeShape);
  protected
    Procedure DefineProperties(Filer:TFiler); override;
    Procedure GetCurvePoints(Var P:TCurvePoints);
    Procedure InternalDraw;
    Procedure PrepareCanvas;
    Procedure SetTree(Value:TCustomTree); override;
    Procedure SetupPoints;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Function Clicked(x,y:Integer):Boolean;
    Function ClickedSegment(x,y:Integer):Integer;
    Function Draw:Boolean;
    Procedure DrawHandles; override;
    procedure DrawText(Angle:Integer);

    //property Points:TConnectionPoints read FPoints;
    property Points:TConnectionPoints read GetPoints;  
    Function Visible:Boolean;
  published
    property ArrowFrom:TConnectionArrowFrom read GetArrowFrom write SetArrowFrom;
    property ArrowTo:TConnectionArrowTo read GetArrowTo write SetArrowTo;
    property Border:TTreeConnectionPen read GetBorder write SetBorder;
    property Font;
    property Style:TTreeConnectionStyle read {FStyle}GetStyle      
                                        write SetStyle default csAuto;
    property Cursor;
    property FromShape:TTreeNodeShape read {FFromShape}GetFromShape write SetFromShape;       
    property ToShape  :TTreeNodeShape read {FToShape}GetToShape write SetToShape;              
    property Text;
  end;

  TTreeNewShapeEvent=Procedure(Sender:TCustomTreePanel; NewShape:TTreeNodeShape) of object;
  TTreeNewConnectionEvent=Procedure(Sender:TCustomTreePanel; NewConnection:TTreeConnection) of object;

  // Pen used to draw borders around selected nodes
  TTreeSelectedPen=class(TTreePen)
  public
    Constructor Create(OnChangeEvent:TNotifyEvent);
  published
    property Color default clYellow;
    property SmallDots default True;
    property Style default psDot;
  end;

  // Non-Visible pen
  TTreeHiddenPen=class(TTreePen)
  public
    Constructor Create(OnChangeEvent:TNotifyEvent);
  published
    property Visible default False;
  end;

  TTreeSelectedUnFocusedPen=TTreeHiddenPen;

  TTreeSelectedHandlesPen=TTreeHiddenPen;

  // List of nodes that are selected
  TSelectedShapeList=class(TPersistent)
  private
    FBorder         : TTreeSelectedPen;
    FBorderUnFocused: TTreeSelectedUnFocusedPen;
    FColor          : TColor;
    FColorUnFocused : TColor;
    FFullRedraw     : Boolean;
    FHandleColor    : TColor;
    FHandleSize     : Integer;
    FHandlePen      : TTreeSelectedHandlesPen;
    FScrollToView   : Boolean;
    FScrollToCenter : Boolean;
    FShiftState     : TShiftState;
    FTextColor      : TColor;

    IFocused        : Boolean; // to optimize redraw time of selected nodes.
    IList           : TNodeShapeList;
    ITree           : TCustomTree;
    Function GetShape(Index:Integer):TTreeNodeShape;
    Function InternalColor:TColor;
    Procedure Repaint;
    Procedure SetBorder(Value:TTreeSelectedPen);
    Procedure SetBorderUnFocused(Value:TTreeSelectedUnFocusedPen);
    Procedure SetColor(Value:TColor);
    Procedure SetColorUnFocused(Value:TColor);
    procedure SetTextColor(Value: TColor);
    procedure SetScrollToCenter(const Value: Boolean);
    procedure SetFullRedraw(const Value: Boolean);
    procedure SetHandlesPen(const Value: TTreeSelectedHandlesPen);
    procedure SetHandleSize(const Value: Integer);
    procedure SetHandleColor(const Value: TColor);
    function GetText: String;
    procedure SetText(const Value: String);
    function GetData: {$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF};
    procedure SetData(const Value: {$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF});
  protected
    Procedure InternalAdd(AShape:TTreeNodeShape);
  public
    Constructor Create(ATree:TCustomTree);
    Destructor Destroy; override;
    Procedure Assign(Value:TPersistent); override;

    Procedure Add(AShape:TTreeNodeShape);
    Procedure Clear;
    Function Count:Integer;
    property Data:{$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF} read GetData write SetData; // For TreeView compatibility.
    Procedure Delete;
    Function First:TTreeNodeShape;
    procedure ForEach(Proc: TNodeListForEachProc);
    Procedure Remove(AShape:TTreeNodeShape);
    Procedure SelectAll;

    property Shapes:TNodeShapeList read IList;
    property Items[Index:Integer]:TTreeNodeShape read GetShape; default;
    property Text:String read GetText write SetText; // For TreeView compatibility.
  published
    property Border:TTreeSelectedPen read FBorder write SetBorder;
    property BorderUnFocused:TTreeSelectedUnFocusedPen read FBorderUnFocused write SetBorderUnFocused;
    property Color:TColor read FColor write SetColor default TeeHighLight;
    property ColorUnFocused:TColor read FColorUnFocused write
                                   SetColorUnFocused default TeeHighLightUnfocused;
    property FullRedraw:Boolean read FFullRedraw write SetFullRedraw default False;
    property HandleColor:TColor read FHandleColor write SetHandleColor default clBlack;
    property HandleSize:Integer read FHandleSize write SetHandleSize default 3;
    property HandlePen:TTreeSelectedHandlesPen read FHandlePen write SetHandlesPen;
    property ScrollToView:Boolean read FScrollToView write FScrollToView default True;
    property ScrollToCenter:Boolean read FScrollToCenter write SetScrollToCenter default False;
    property ShiftState:TShiftState read FShiftState write FShiftState default [ssShift];
    property TextColor: TColor read FTextColor write SetTextColor
                        default TeeHighLightText;
  end;

  // Default gray pen for nodes "cross-box" 
  TTreeCrossBoxPen=class(TTreePen)
  published
    property Color default clGray;
  end;

  TClickConnectionEvent=procedure( Sender:TTreeConnection;
                                   Button:TMouseButton;
                                   Shift: TShiftState;
                                   X, Y: Integer) of object;

  TTreeCrossBoxStyle=(cbsSquare,cbsDiamond,cbsCircle);

  // Cross-Box object.
  // The CrossBox is the plus/minus box used to expand/collapse nodes
  TTreeNodeCrossBox=class(TPersistent)
  private
    FBackColor      : TColor;
    FBorder         : TTreeCrossBoxPen;
    FBrush          : TTreeBrush;
    FClickTolerance : Integer;
    FSignPen        : TTreePen;
    FSize           : Integer;
    FStyle          : TTreeCrossBoxStyle;
    FVisible        : Boolean;

    { private internal }
    FTree   : TCustomTree;
    procedure SetBackColor(const Value: TColor);
    procedure SetBorder(Value:TTreeCrossBoxPen);
    Procedure SetBrush(Value:TTreeBrush);
    Procedure SetSignPen(Value:TTreePen);
    procedure SetSize(Value:Integer);
    procedure SetStyle(const Value: TTreeCrossBoxStyle);
    procedure SetVisible(Value:Boolean);
  public
    Constructor Create(AOwner:TCustomTree);
    Destructor Destroy; override;
    Procedure Assign(Source:TPersistent); override;
    Procedure Draw(Const AtPoint:TPoint; DrawExpanded:Boolean);
  published
    property BackColor:TColor read FBackColor write SetBackColor default clNone;
    property Border:TTreeCrossBoxPen read FBorder write SetBorder;
    property Brush:TTreeBrush read FBrush write SetBrush;
    property ClickTolerance:Integer read FClickTolerance
                                    write FClickTolerance default 0;
    property SignPen:TTreePen read FSignPen write SetSignPen;
    property Size:Integer read FSize write SetSize default TeeDefaultBoxSize;
    property Style:TTreeCrossBoxStyle read FStyle write SetStyle default cbsSquare;
    property Visible:Boolean read FVisible write SetVisible default True;
  end;

  TNotifyShapeEvent=procedure(Sender:TTreeNodeShape) of object;
  TNotifyConnectionEvent=procedure(Sender:TTreeConnection) of object;
  TDeleteShapesEvent=Procedure(Sender:TSelectedShapeList; Var AllowDelete:Boolean) of object;
  TShowHintShapeEvent=Procedure(Sender:TCustomTree; Shape:TTreeNodeShape; var Text:String) of object;

  TTreeChangingEvent=procedure(Sender:TCustomTree; Node:TTreeNodeShape;
                                                   Var Allow:Boolean) of object;

  TMovingShapeEvent=procedure(Sender:TTreeNodeShape; Var DeltaX,DeltaY:Integer)
                                                     of object;

  TTreeResizingShape=procedure( Sender:TTreeNodeShape;
                                ACorner:TTreeShapeHandle;
                                Var DeltaX,DeltaY:Integer) of object;

  // Record to backup and restore Tree events
  TTreeEvents=packed record
    FAfterDraw           : TNotifyEvent;
    FBeforeDraw          : TNotifyEvent;
    FMouseDown           : TMouseEvent;
    FMouseUp             : TMouseEvent;
    FMouseMove           : TMouseMoveEvent;
    FChanging            : TTreeChangingEvent;
    FClickBackGround     : TTreeClick;
    FClickConnection     : TClickConnectionEvent;
    FClickShape          : TClickShapeEvent;
    FDblClickConnection  : TClickConnectionEvent;
    FDblClickShape       : TClickShapeEvent;
    FDeletingShapes      : TDeleteShapesEvent;
    FDeletedShapes       : TNotifyEvent;
    FExpandedCollapsed   : TNotifyShapeEvent;
    FExpandingCollapsing : TExpandingCollapsingEvent;
    FMovingShape         : TMovingShapeEvent;
    FMouseEnterShape     : TMouseShapeEvent;
    FMouseLeaveShape     : TMouseShapeEvent;
    FResizingShape       : TTreeResizingShape;
    FSelectShape         : TNotifyShapeEvent;
    FSelectConnection    : TNotifyConnectionEvent;
    FUnSelectConnection  : TNotifyConnectionEvent;
    FUnSelectShape       : TNotifyShapeEvent;
    FScroll              : TNotifyEvent;
    FZoom                : TNotifyEvent;
  end;

  // ScrollBar
  TTeeScrollBar=class(TPersistent)
  private
    FAutomatic : Boolean;
    FFlat      : Boolean;
    FMin       : Integer;
    FMax       : Integer;
    FPageSize  : Integer;
    FVisible   : Boolean;

    ITree      : TCustomTree;
    ICode      : Integer;
    {$IFNDEF CLX}
    Function CalcScrollOffset(ScrollCode:Integer):Integer;
    {$ENDIF}
    Function CanModifyBar:Boolean;
    Procedure ChangeVisible(Value:Boolean);
    Procedure DoCheckMinMax;
    function GetPosition: Integer;
    Procedure InternalSetRange(Redraw:Boolean);
    Procedure SetAutomatic(Value:Boolean);
    Procedure SetFlat(Value:Boolean);
    Procedure SetMax(Value:Integer);
    Procedure SetMin(Value:Integer);
    procedure SetPageSize(Value:Integer);
    procedure SetPosition(Value:Integer);
    Procedure SetRange;
    Procedure SetScrollParams(Offset:Integer);
    Procedure SetVisible(Value:Boolean);
  protected
    Procedure CheckScroll(AMin,AMax,AOffset,ASize:Integer);
    Function Vertical:Boolean;
  public
    Constructor Create(ATree:TCustomTree; IsHoriz:Boolean);

    Procedure Assign(Source:TPersistent); override;
    property Position:Integer read GetPosition;
  published
    property Automatic:Boolean read FAutomatic write SetAutomatic default True;
    property Flat:Boolean read FFlat write SetFlat default False;
    property Max:Integer read FMax write SetMax default TeeDefaultMaxScroll;
    property Min:Integer read FMin write SetMin default TeeDefaultMinScroll;
    property PageSize:Integer read FPageSize write SetPageSize default 0;
    property Visible:Boolean read FVisible write SetVisible default False;
  end;

  // List of nodes, used in TCustomTree to store all nodes.
  TTreeShapeList=class(TNodeShapeList)
  private
    FVisible : Boolean;
    Procedure SetVisible(Const Value:Boolean);
  public
    property Visible:Boolean read FVisible write SetVisible;
    Function AddChild(Node:TTreeNodeShape; Const Text:String):TTreeNodeShape;
    Procedure Assign(Source:TTreeShapeList);
  end;

  TTreeZoomedAreaEvent=Procedure(Const R:TRect) of object;

  // Mouse-Wheel navigation options.
  TTreeWheelNavigation=(
                         wnSelection,    // mouse wheel selects nodes
                         wnScrollVert,   // mouse wheel scrolls vertically
                         wnScrollHoriz,  // mouse wheel scrolls horizontally
                         wnZoom,         // mouse wheel zooms in and out
                         wnNone          // mouse wheel does nothing.
                        );

  // Different keyboard navigation styles.
  TTreeNavigation=(
                    tnExplorer,  // arrow keys select and expand/collapse nodes
                    tnNearest,   // arrow keys select nearest node to current
                    tnNone,      // keyboard does not select nor expands nodes
                    tnCircularExplorer  // same as Explorer. Last goes to First.
                  );

  // Abstract base class for "Child Managers".
  // A "Child Manager" is an object responsible to re-position nodes
  // and draw connection lines between parent and children.
  //
  // See Tree1.GlobalFormat.ChildManager element.
  TChildManager=class
  public
    Function CalcXYCross(ANode,AParent:TTreeNodeShape):TPoint; virtual; abstract;
    Function DrawConnection(AConnection:TTreeConnection):Boolean; virtual; abstract;
    Function XPosition(ANode:TTreeNodeShape):Integer; virtual; abstract;