treeflow.pas

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

{**********************************************}
{   TTree Component - Flow-Chart Shapes        }
{   Copyright (c) 1998-2002 by David Berneda   }
{**********************************************}
{$I TeeDefs.inc}
unit TreeFlow;

{ Several customized shapes used in Flow-Chart diagramms }
interface

Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes,
     {$IFDEF CLX}
     QGraphics, Types, QControls, QExtCtrls,
     {$ELSE}
     Graphics, Controls, ExtCtrls,
     {$ENDIF}
     TeeTree, TeCanvas;

type TFlowChartShape=class(TCustomTreeShape);

     TDecisionShape=class(TFlowChartShape)
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property Style default tssDiamond;
     end;

     TConditionShape=class(TDecisionShape); // alias

     TProcessShape=class(TFlowChartShape)
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property Style default tssRectangle;
     end;

     TPredefinedProcessShape = class(TProcessShape)
     protected
       procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
     end;

     TTerminalShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TConnectorShape=class(TFlowChartShape)
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property Style default tssCircle;
     end;

     TInputOutputShape=class(TFlowChartShape)
     private
       FSlant : Double;
       Function ClickedSlantPoint(x,y:Integer):Boolean;
       procedure SetSlant(const Value: Double);
       Function SlantSize(Const R:TRect):Integer;
     protected
       Function GetHandleCursor(x,y:Integer):TCursor; override;
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
       Procedure DrawHandles; override;
       function GetResizingHandle(x, y: Integer): TTreeShapeHandle; override;
       Procedure Resize(ACorner:TTreeShapeHandle; DeltaX,DeltaY:Integer); override;
     published
       property Slant:Double read FSlant write SetSlant;
     end;

     TTitleShape=class(TInputOutputShape); // alias

     TManualOperationShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TSelectShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TDocumentShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TPunchCardShape=class(TFlowChartShape)
     private
       FPercentHoriz:Integer;
       FPercentVert:Integer;
       procedure SetPercentHoriz(const Value: Integer);
       procedure SetPercentVert(const Value: Integer);
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property PercentHoriz:Integer read FPercentHoriz write SetPercentHoriz default 25;
       property PercentVert:Integer read FPercentVert write SetPercentVert default 25;
     end;

     TCardShape=class(TPunchCardShape); // alias

     TPunchTapeShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TDelayShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TManualInputShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TManualShape=class(TManualInputShape); // alias

     TFlowChartCircleShape=class(TFlowChartShape)
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property Style default tssCircle;
     end;

     TAndShape=class(TFlowChartCircleShape)
     protected
       procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
     end;

     TOrShape=class(TFlowChartCircleShape)
     protected
       procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
     end;

     TOnlineStorageShape=class(TFlowChartShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TDataShape=class(TOnlineStorageShape); // alias

     TMagneticTapeShape=class(TFlowChartCircleShape)
     protected
       procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
     end;

     TTapeShape=class(TMagneticTapeShape); // alias

     { "Other" custom shapes }
     TPentagonShape=class(TTreeCustomPolygonShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     THexagonShape=class(TTreeCustomPolygonShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TOctagonShape=class(TTreeCustomPolygonShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     end;

     TCrossShape=class(TCustomTreeShape)
     private
       FPercentHoriz : Integer;
       FPercentVert  : Integer;
       procedure SetHoriz(const Value: Integer);
       procedure SetVert(const Value: Integer);
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property PercentHoriz:Integer read FPercentHoriz write SetHoriz default 25;
       property PercentVert:Integer read FPercentVert write SetVert default 25;
     end;

     TTriangleRectShape=class(TCustomTreeShape)
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property VertTextAlign default vtaBottom;
     end;

     TTriangleRectRightShape=class(TTriangleRectShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TTriangleRectLeftShape=class(TTriangleRectShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     THouseShape=class(TCustomTreeShape)
     private
       FWallSize: Double;
       Function ClickedMiddle(x,y:Integer):Boolean;
       Function InternalWallSize(Const R:TRect):Integer;
       procedure SetWallSize(const Value: Double);
     protected
       Function GetHandleCursor(x,y:Integer):TCursor; override;
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner: TComponent); override;

       Procedure DrawHandles; override;
       function GetResizingHandle(x, y: Integer): TTreeShapeHandle; override;
       Procedure Resize(ACorner:TTreeShapeHandle; DeltaX,DeltaY:Integer); override;
     published
       property WallSize:Double read FWallSize write SetWallSize;
     end;

     TEnvelopeShape=class(TTreeNodeShape)
     private
       FOffsetY : Integer;
       Function ClickedMiddle(x,y:Integer):Boolean;
       Function MiddlePoint(Const R:TRect):TPoint;
       procedure SetOffsetY(const Value: Integer);
     protected
       procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
       Function GetHandleCursor(x,y:Integer):TCursor; override;
     public
       Constructor Create(AOwner: TComponent); override;

       Procedure DrawHandles; override;
       Function GetResizingHandle(x,y:Integer):TTreeShapeHandle; override;
       Procedure Resize(ACorner:TTreeShapeHandle; DeltaX,DeltaY:Integer); override;
     published
       property OffsetY:Integer read FOffsetY write SetOffsetY default 33;
     end;

     TRingShape=class(TTreeNodeShape)
     protected
       procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property Style default tssCircle;
     end;

     TTreeCustomArrowShape=class(TCustomTreeShape)
     private
       FPercentHoriz : Integer;
       FPercentVert  : Integer;
       procedure SetHoriz(const Value: Integer);
       procedure SetVert(const Value: Integer);
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property PercentHoriz:Integer read FPercentHoriz write SetHoriz default 25;
       property PercentVert:Integer read FPercentVert write SetVert default 33;
     end;

     TArrowUpShape=class(TTreeCustomArrowShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TArrowDownShape=class(TTreeCustomArrowShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TArrowLeftShape=class(TTreeCustomArrowShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
      end;

     TArrowRightShape=class(TTreeCustomArrowShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

     TCallOutShape=class(TCustomTreeShape)
     private
       FPosX : Integer;
       FPosY : Integer;
       Function CallOutPoint(Const R:TRect):TPoint;
       Function ClickedCallOut(x,y:Integer):Boolean;
     protected
       Function GetHandleCursor(x,y:Integer):TCursor; override;
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     public
       Constructor Create(AOwner:TComponent); override;

       Procedure DrawHandles; override;
       Function GetResizingHandle(x,y:Integer):TTreeShapeHandle; override;
       Procedure Resize(ACorner:TTreeShapeHandle; DeltaX,DeltaY:Integer); override;
     end;

     TStarShape=class(TCustomTreeShape)
     protected
       Function GetShapePoints(Const R:TRect; Var P:TShapePoints):Integer; override;
     end;

Const MaxRows=100;
      MaxCols=100;

type
  TGridCellShape=class(TTreeNodeShape)
  protected
    procedure CanvasChanged(Sender:TObject); override;
    Procedure SetSelected(Value:Boolean); override;
  public
    Column : Integer;
    Row    : Integer;
  end;

  TGridShape=class; // forward

  TGridShapeNewCellEvent=procedure(Sender:TGridShape; Row,Col:Integer) of object;

  TGridShape=class(TTreeNodeShape)
  private
    FCell : Array[0..MaxRows,0..MaxCols] of TGridCellShape;

    FColumns     : Integer;
    FRows        : Integer;
    FGridLines   : TTreePen;
    FOnNewCell   : TGridShapeNewCellEvent;
    FSelectedCol : Integer;
    FSelectedRow : Integer;

    procedure SetColumns(const Value: Integer);
    procedure SetRows(const Value: Integer);
    procedure SetGridLines(const Value: TTreePen);
  protected
    Function CellRect(Const R:TRect; Row,Col:Integer):TRect;
    Procedure DoClick( Button:TMouseButton; Shift:TShiftState;
                       x,y:Integer); override;
    procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
    function GetCell(Row, Col: Integer): TGridCellShape; virtual;
    Function GetEditedShape:TTreeNodeShape; override;
    Function GetHandleCursor(x,y:Integer):TCursor; override;
    procedure Loaded; override;
    Procedure SetSelected(Value:Boolean); override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure AddColumn;
    Procedure AddRow;
    Function CellAt(x,y:Integer):TGridCellShape;
    Procedure ClearSelection;
    Procedure DeleteColumn(Column:Integer);
    Procedure DeleteRow(Row:Integer);
    Procedure RecalcSize(ACanvas:TCanvas3D); override;

    property Cells[Row,Col:Integer]:TGridCellShape read GetCell; default;
  published
    property AutoSize default False;
    property Columns:Integer read FColumns write SetColumns;
    property GridLines:TTreePen read FGridLines write SetGridLines;
    property Rows:Integer read FRows write SetRows;
    property Transparent default True;

    property OnNewCell:TGridShapeNewCellEvent read FOnNewCell
                                              write FOnNewCell;
  end;

  TBeveledShape=class(TTreeNodeShape)
  private
    FBevel     : TPanelBevel;
    FBevelSize : Integer;
    procedure SetBevel(const Value: TPanelBevel);
    procedure SetBevelSize(const Value: Integer);
  protected
    procedure DrawShapeCanvas(ACanvas:TCanvas3D; Const R:TRect); override;
  public
    Constructor Create(AOwner : TComponent); override;
  published
    property Bevel:TPanelBevel read FBevel write SetBevel default bvRaised;
    property BevelSize:Integer read FBevelSize write SetBevelSize default 1;
    property Color default clBtnFace;
  end;

implementation

Uses SysUtils, Math, TreeConst;

type TTreeAccess=class(TCustomTree);

{ Decision }
Constructor TDecisionShape.Create(AOwner:TComponent);
begin
  inherited;
  Style:=tssDiamond;
  Brush.Color:=clRed;
  Font.Color:=clWhite;
end;

{ Process }
Constructor TProcessShape.Create(AOwner:TComponent);
begin
  inherited;
  Style:=tssRectangle;
end;

{ TPredefinedProcessShape }
procedure TPredefinedProcessShape.DrawShapeCanvas(ACanvas: TCanvas3D; const R: TRect);
Var xp      : Integer;

begin
  inherited;
  with R do begin
    xp:=Abs(Right-Left) div 6;
    ACanvas.MoveTo3D(Left+xp,Top,TeeTreeZ);
    ACanvas.LineTo3D(Left+xp,Bottom,TeeTreeZ);
    ACanvas.MoveTo3D(Right-xp,Top,TeeTreeZ);
    ACanvas.LineTo3D(Right-xp,Bottom,TeeTreeZ);
  end;
end;


{ Connector }
Constructor TConnectorShape.Create(AOwner:TComponent);
begin
  inherited;
  Style:=tssCircle;
end;

{ TTerminalShape }
function TTerminalShape.GetShapePoints(const R: TRect;
  var P: TShapePoints): Integer;
var xc      : Integer;
    yc      : Integer;
    XRadius : Integer;
    YRadius : Integer;
    tmpOffset : Double;
    tmpStep : Double;

  Procedure DrawCurve(AOffset,AFactor,AInverse:Integer);
  Var t     : Integer;
      Angle : Double;
  begin
    for t:=1 to 16 do
    begin
      Angle:=tmpOffset+t*tmpStep;
      P[AOffset+t].X:=xc-(Round(XRadius*Cos(Angle))*AInverse);
      P[AOffset+t].Y:=yc+AFactor*Round(YRadius*Sin(Angle));
    end;
  end;

begin
  result:=33;
  With R do
  begin
    yc:=(Bottom+Top) div 2;
    XRadius:=(Right-Left) div 4;
    YRadius:=(Bottom-Top) div 2;
    xc:=Right-XRadius;
    P[0]:=TeePoint(xc,Top);    
  end;
  tmpOffset:=1.5*pi;
  tmpStep:=Pi/16.0;
  DrawCurve(0,1,-1);
  xc:=R.Left+XRadius;
  DrawCurve(16,-1,1);
end;

{ InputOutput }
Constructor TInputOutputShape.Create(AOwner:TComponent);
begin
  inherited;
  Brush.Color:=clYellow;
  FSlant:=12.5;