tecanvas.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 2,088 行 · 第 1/5 页

       IFont        : TTeeFont;
       Procedure SetCanvas(ACanvas:TCanvas);

       function GetBackColor:TColor; virtual;
       Function GetBackMode:TCanvasBackMode; virtual;
       Function GetHandle:TTeeCanvasHandle; virtual; abstract;
       Function GetMonochrome:Boolean; virtual; abstract;
       Function GetPixel(x,y:Integer):TColor; virtual; abstract;
       Function GetTextAlign:TCanvasTextAlign; virtual; abstract;
       Function GetUseBuffer:Boolean; virtual; abstract;
       Procedure SetBackColor(Color:TColor); virtual;
       Procedure SetBackMode(Mode:TCanvasBackMode); virtual;
       Procedure SetMonochrome(Value:Boolean); virtual; abstract;
       procedure SetPixel(X, Y: Integer; Value: TColor); virtual; abstract;
       procedure SetTextAlign(Align:TCanvasTextAlign); virtual; abstract;
       Procedure SetUseBuffer(Value:Boolean); virtual; abstract;
     public
       FontZoom : Double; // % of zoom of all font sizes

       Procedure AssignBrush(ABrush:TChartBrush; ABackColor:TColor);
       Procedure AssignBrushColor(ABrush:TChartBrush; AColor,ABackColor:TColor);
       procedure AssignVisiblePen(APen:TPen);
       procedure AssignVisiblePenColor(APen:TPen; AColor:TColor);
       procedure AssignFont(AFont:TTeeFont);
       Procedure ResetState;

       Function BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend; virtual;
       procedure EndBlending(Blend:TTeeBlend); virtual;

       { 2d }
       procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); virtual; abstract;
       procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                        Const StartAngle,EndAngle,HolePercent:Double); virtual; abstract;
       procedure Draw(X, Y: Integer; Graphic: TGraphic); virtual; abstract;
       procedure Ellipse(const R:TRect); overload;
       procedure Ellipse(X1, Y1, X2, Y2: Integer); overload; virtual; abstract;
       procedure FillRect(const Rect: TRect); virtual; abstract;
       procedure Frame3D( var Rect: TRect; TopColor,BottomColor: TColor;
                          Width: Integer); virtual; abstract;
       procedure LineTo(X,Y:Integer); virtual; abstract;
       procedure MoveTo(X,Y:Integer); virtual; abstract;
       procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); virtual; abstract;
       procedure Rectangle(const R:TRect); overload;
       procedure Rectangle(X0,Y0,X1,Y1:Integer); overload; virtual; abstract;
       procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); overload; virtual; abstract;
       procedure RoundRect(Const R:TRect; X,Y:Integer); overload;
       procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); overload; virtual; abstract;
       Procedure TextOut(X,Y:Integer; const Text:String); virtual; abstract;
       Function TextWidth(Const St:String):Integer; virtual;
       Function TextHeight(Const St:String):Integer; virtual;
       Function FontHeight:Integer;

       { 2d extra }
       procedure ClipRectangle(Const Rect:TRect); virtual; abstract;
       Procedure DoHorizLine(X0,X1,Y:Integer); virtual; abstract;
       Procedure DoRectangle(Const Rect:TRect); // obsolete
       Procedure DoVertLine(X,Y0,Y1:Integer); virtual; abstract;
       procedure EraseBackground(const Rect: TRect); virtual; abstract;
       Procedure GradientFill( Const Rect:TRect;
                               StartColor,EndColor:TColor;
                               Direction:TGradientDirection;
                               Balance:Integer=50); virtual; abstract;
       Procedure Invalidate; virtual; abstract;
       Procedure Line(X0,Y0,X1,Y1:Integer);  overload; virtual; abstract;
       Procedure Line(const FromPoint,ToPoint:TPoint); overload;
       {$IFDEF D5}
       Procedure Polyline(const Points:Array of TPoint); overload; virtual; abstract;
       {$ELSE}
       Procedure Polyline(const Points:TPointArray); overload; virtual; abstract;
       {$ENDIF}
       Procedure Polygon(const Points: Array of TPoint); virtual; abstract;
       procedure RotateLabel( x,y:Integer; Const St:String;
                              RotDegree:Integer); virtual; abstract;
       procedure UnClipRectangle; virtual; abstract;

     { properties }
       property BackColor:TColor read GetBackColor write SetBackColor;
       property BackMode:TCanvasBackMode read GetBackMode write SetBackMode;
       property Brush:TBrush read FBrush;
       property Font:TFont read FFont;
       property Handle:TTeeCanvasHandle read GetHandle;
       property Metafiling:Boolean read FMetafiling write FMetafiling;
       property Monochrome:Boolean read GetMonochrome write SetMonochrome;
       property Pen:TPen read FPen;
       property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
       property ReferenceCanvas:TCanvas read FCanvas write SetCanvas;
       property TextAlign:TCanvasTextAlign read GetTextAlign write SetTextAlign;
       property UseBuffer:Boolean read GetUseBuffer write SetUseBuffer;
     end;

     { 3d }
     TPoint3DFloat=packed record
       X : Double;
       Y : Double;
       Z : Double;
     end;

     TPoint3D         =Packed Record x,y,z:Integer; end;
     TTrianglePoints  =Array[0..2] of TPoint;
     TTrianglePoints3D=Array[0..2] of TPoint3D;
     TTriangleColors3D=Array[0..2] of TColor;

     TTeeCanvasCalcPoints=Function( x,z:Integer; Var P0,P1:TPoint3D;
                                    Var Color0,Color1:TColor):Boolean of object;

     TTeeCanvasSurfaceStyle=(tcsSolid,tcsWire,tcsDot);

     TCanvas3D=class(TTeeCanvas)
     private
       F3DOptions    : TView3DOptions;
     protected
       FIsOrthogonal : Boolean;  // 6.01, moved from private due to RotateTool
       Function GetPixel3D(X,Y,Z:Integer):TColor; virtual; abstract;
       Function GetSupportsFullRotation:Boolean; virtual; abstract;
       Function GetSupports3DText:Boolean; virtual; abstract;
       procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); virtual; abstract;
     public
       RotationCenter : TPoint3DFloat;

       { 3d }
       Function CalcRect3D(Const R:TRect; Z:Integer):TRect;
       Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); virtual; abstract;
       Function Calculate3DPosition(P:TPoint; z:Integer):TPoint; overload;
       Function Calculate3DPosition(x,y,z:Integer):TPoint; overload; virtual; abstract;

       Function FourPointsFromRect(Const R:TRect; Z:Integer):TFourPoints;
       Function RectFromRectZ(Const R:TRect; Z:Integer):TRect;

       Function InitWindow( DestCanvas:TCanvas; A3DOptions:TView3DOptions;
                            ABackColor:TColor;
                            Is3D:Boolean;
                            Const UserRect:TRect):TRect; virtual; abstract;

       Procedure Assign(Source:TCanvas3D); virtual;

       Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); virtual; abstract;
       Procedure ShowImage( DestCanvas,DefaultCanvas:TCanvas;
                            Const UserRect:TRect); virtual; abstract;
       Function ReDrawBitmap:Boolean; virtual; abstract;

       Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
                        ArrowWidth,ArrowHeight,Z:Integer); virtual; abstract;
       procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); virtual; abstract;
       procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                       Dark3D:Boolean; ConePercent:Integer); virtual; abstract;
       Procedure Cube( Left,Right,Top,Bottom,Z0,Z1:Integer;
                       DarkSides:Boolean); overload; virtual; abstract;
       Procedure Cube( const R:TRect; Z0,Z1:Integer;
                       DarkSides:Boolean); overload;

       procedure Cylinder( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                           Dark3D:Boolean); virtual; abstract;
       Procedure HorizLine3D(Left,Right,Y,Z:Integer); virtual; abstract;
       Procedure VertLine3D(X,Top,Bottom,Z:Integer); virtual; abstract;
       Procedure ZLine3D(X,Y,Z0,Z1:Integer); virtual; abstract;
       procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); virtual; abstract;
       procedure FrontPlaneBegin; virtual; abstract;
       procedure FrontPlaneEnd; virtual; abstract;
       Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer);  overload; virtual; abstract;
       Procedure LineWithZ(const FromPoint,ToPoint:TPoint; Z:Integer); overload;
       procedure MoveTo3D(X,Y,Z:Integer); virtual; abstract;
       procedure LineTo3D(X,Y,Z:Integer); virtual; abstract;
       procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
                        Const StartAngle,EndAngle:Double;
                        DarkSides,DrawSides:Boolean;
                        DonutPercent:Integer=0); virtual; abstract;
       procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); virtual; abstract;
       procedure PlaneWithZ(const P:TFourPoints; Z:Integer); overload;
       procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); overload; virtual; abstract;
       procedure PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); virtual; abstract;
       procedure PolygonWithZ(Points: Array of TPoint; Z:Integer); virtual; abstract;
       procedure Polyline(const Points: Array of TPoint; Z:Integer); overload; virtual; abstract;
       procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
                          DarkSides:Boolean); virtual; abstract;
       Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
                              TruncX,TruncZ:Integer); virtual; abstract;
       Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); virtual; abstract;
       Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); virtual; abstract;
       Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); virtual; abstract;
       procedure RotatedEllipse(Left,Top,Right,Bottom,Z:Integer; Const Angle:Double); 
       procedure RotateLabel3D( x,y,z:Integer; Const St:String;
                                RotDegree:Integer); virtual; abstract;
       procedure Sphere(x,y,z:Integer; Const Radius:Double); virtual; abstract;
       procedure StretchDraw(const Rect: TRect; Graphic: TGraphic; Z:Integer); overload;
       Procedure Surface3D( Style:TTeeCanvasSurfaceStyle;
                            SameBrush:Boolean; NumXValues,NumZValues:Integer;
                            CalcPoints:TTeeCanvasCalcPoints ); virtual; abstract;
       Procedure TextOut3D(x,y,z:Integer; const Text:String); virtual; abstract;
       procedure Triangle3D( Const Points:TTrianglePoints3D;
                             Const Colors:TTriangleColors3D); virtual; abstract;
       procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); virtual; abstract;

       property Pixels3D[X,Y,Z:Integer]:TColor read GetPixel3D write SetPixel3D;
       property Supports3DText:Boolean read GetSupports3DText;
       property SupportsFullRotation:Boolean read GetSupportsFullRotation;
       property View3DOptions:TView3DOptions read F3DOptions write F3DOptions;
     end;

{.$DEFINE NEWXYZ}

     TTeeCanvas3D=class(TCanvas3D)
     private
       FXCenter        : Integer;
       FYCenter        : Integer;
       FZCenter        : Integer;
       FXCenterOffset  : Integer;
       FYCenterOffset  : Integer;

       s1              : Extended;
       s2              : Extended;
       s3              : Extended;
       c1              : Extended;
       c2              : Extended;
       c3              : Extended;

       {$IFNDEF NEWXYZ}
       c2s1            : Double;
       c2c1            : Double;
       {$ENDIF}

       c2s3            : Double;
       c2c3            : Double;
       tempXX          : Double;
       tempYX          : Double;
       tempXZ          : Double;
       tempYZ          : Double;

       FWas3D          : Boolean;

       FBitmap         : TBitmap;
       {$IFDEF TEEBITMAPSPEED}
       IBitmapCanvas   : TTeeCanvasHandle;
       {$ENDIF}

       FDirty          : Boolean;
       FMonochrome     : Boolean;
       FTextAlign      : TCanvasTextAlign;

       FBounds         : TRect;

       IHasPerspec     : Boolean;
       IOrthoX         : Double;
       IOrthoY         : Double;
       IZoomPerspec    : Double;
       IZoomFactor     : Double;
       IZoomText       : Boolean;

       procedure InternalCylinder(Vertical:Boolean; Left,Top,Right,Bottom,
                            Z0,Z1:Integer; Dark3D:Boolean; ConePercent:Integer);
     protected
       FBufferedDisplay : Boolean;
       FIs3D            : Boolean;
       IPoints          : TFourPoints;

       { 2d }
       Function GetHandle:TTeeCanvasHandle; override;
       Function GetMonochrome:Boolean; override;
       Function GetPixel(X, Y: Integer):TColor; override;
       Function GetPixel3D(X,Y,Z:Integer):TColor; override;
       Function GetSupports3DText:Boolean; override;
       Function GetSupportsFullRotation:Boolean; override;
       Function GetTextAlign:TCanvasTextAlign; override;
       Function GetUseBuffer:Boolean; override;

       Procedure PolygonFour; virtual;

       Procedure SetMonochrome(Value:Boolean); override;
       procedure SetPixel(X, Y: Integer; Value: TColor); override;
       procedure SetTextAlign(Align:TCanvasTextAlign); override;
       Procedure SetUseBuffer(Value:Boolean); override;

       Procedure DeleteBitmap; virtual;
       Procedure TransferBitmap(ALeft,ATop:Integer; ACanvas:TCanvas); virtual;

       { 3d private }
       Procedure Calc3DTPoint(Var P:TPoint; z:Integer);
       Function Calc3DTPoint3D(Const P:TPoint3D):TPoint;
       Procedure Calc3DPoint(Var P:TPoint; x,y,z:Integer);

       { 3d }
       procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;
       Procedure Calc3DPos(var x,y:Integer; z:Integer); overload;

       Procedure CalcPerspective(const Rect:TRect);
       Procedure CalcTrigValues;
     public
       { almost public... }
       Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); override;
       Function Calculate3DPosition(x,y,z:Integer):TPoint; override;

       { public }
       Constructor Create;
       Destructor Destroy; override;

       Function InitWindow( DestCanvas:TCanvas;
                            A3DOptions:TView3DOptions;
                            ABackColor:TColor;
                            Is3D:Boolean;
                            Const UserRect:TRect):TRect; override;
       Function ReDrawBitmap:Boolean; override;
       Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;

       procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
       procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                        Const StartAngle,EndAngle,HolePercent:Double); override;
       procedure Draw(X, Y: Integer; Graphic: TGraphic); override;
       procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
       procedure EraseBackground(const Rect: TRect); override;
       procedure FillRect(const Rect: TRect); override;
       procedure Frame3D( var Rect: TRect; TopColor,BottomColor: TColor;
                          Width: Integer); override;
       procedure LineTo(X,Y:Integer); override;
       procedure MoveTo(X,Y:Integer); override;
       procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
       procedure Rectangle(X0,Y0,X1,Y1:Integer); override;
       procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
       procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); override;
       Procedure TextOut(X,Y:Integer; const Text:String); override;

       { 2d extra }
       procedure ClipRectangle(Const Rect:TRect); override;
       procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); override;
       Procedure DoHorizLine(X0,X1,Y:Integer); override;
       Procedure DoVertLine(X,Y0,Y1:Integer); override;
       Procedure GradientFill( Const Rect:TRect;
                               StartColor,EndColor:TColor;
                               Direction:TGradientDirection;
                               Balance:Integer=50); override;
       Procedure Invalidate; override;
       Procedure Line(X0,Y0,X1,Y1:Integer); override;
       {$IFDEF D5}
       Procedure Polyline(const Points:Array of TPoint); override;
       {$ELSE}
       Procedure Polyline(const Points:TPointArray); override;
       {$ENDIF}
       Procedure Polygon(const Points: Array of TPoint); override;
       procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Integer); override;
       procedure RotateLabel3D( x,y,z:Integer;
                                Const St:String; RotDegree:Integer); override;
       procedure UnClipRectangle; override;

       property XCenter:Integer read FXCenter write FXCenter;
       property YCenter:Integer read FYCenter write FYCenter;
       property ZCenter:Integer read FZCenter write FZCenter;

       { 3d }
       Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); override;

       Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
                        ArrowWidth,ArrowHeight,Z:Integer); override;
       procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                       Dark3D:Boolean; ConePercent:Integer); override;
       Procedure Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean); override;
       procedure Cylinder( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                           Dark3D:Boolean); override;
       procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); override;
       Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); override;
       Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); override;
       procedure FrontPlaneBegin; override;
       procedure FrontPlaneEnd; override;
       Procedure HorizLine3D(Left,Right,Y,Z:Integer); override;
       procedure LineTo3D(X,Y,Z:Integer); override;
       Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer); override;
       procedure MoveTo3D(X,Y,Z:Integer); override;
       procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
                        Const StartAngle,EndAngle:Double;
                        DarkSides,DrawSides:Boolean; DonutPercent:Integer=0); override;
       procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); override;
       procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); override;
       procedure PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); override;
       procedure PolygonWithZ(Points: Array of TPoint; Z:Integer); override;
       procedure Polyline(const Points: Array of TPoint; Z:Integer); override;
       procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
                          DarkSides:Boolean); override;
       Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
                              TruncX,TruncZ:Integer); override;
       Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); override;
       procedure Sphere(x,y,z:Integer; Const Radius:Double); override;
       Procedure Surface3D( Style:TTeeCanvasSurfaceStyle;
                            SameBrush:Boolean;
                            NumXValues,NumZValues:Integer;
                            CalcPoints:TTeeCanvasCalcPoints ); override;
       Procedure TextOut3D(X,Y,Z:Integer; const Text:String); override;
       procedure Triangle3D( Const Points:TTrianglePoints3D;
                             Const Colors:TTriangleColors3D); override;
       procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); override;
       Procedure VertLine3D(X,Top,Bottom,Z:Integer); override;
       Procedure ZLine3D(X,Y,Z0,Z1:Integer); override;

       property Bitmap:TBitmap read FBitmap;
       property Bounds:TRect read FBounds;
     end;

Function ApplyDark(Color:TColor; HowMuch:Byte):TColor;
Function ApplyBright(Color:TColor; HowMuch:Byte):TColor;

Function Point3D(x,y,z:Integer):TPoint3D;

Procedure SwapDouble(Var a,b:Double);    { exchanges a and b }
Procedure SwapInteger(Var a,b:Integer);  { exchanges a and b }

Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Integer);
Procedure RectCenter(Const R:TRect; Var X,Y:Integer);
Function RectFromPolygon(Const Points:Array of TPoint; NumPoints:Integer):TRect;
Procedure ClipCanvas(ACanvas:TCanvas; Const Rect:TRect);
Procedure UnClipCanvas(ACanvas:TCanvas);

Procedure ClipEllipse(ACanvas:TTeeCanvas; Const Rect:TRect);
Procedure ClipRoundRectangle(ACanvas:TTeeCanvas; Const Rect:TRect; RoundSize:Integer);
Procedure ClipPolygon(ACanvas:TTeeCanvas; Var Points:Array of TPoint; NumPoints:Integer);

Const TeeCharForHeight     = 'W';  { <-- this is used to calculate Text Height }
      DarkerColorQuantity  : Byte=128; { <-- for dark 3D sides }
      DarkColorQuantity    : Byte=64;

type
  TButtonGetColorProc=function:TColor of object;