tecanvas.pas

BCB第三方组件

                               StartColor,EndColor:TColor;
                               Direction:TGradientDirection;
                               Balance:Integer=50); virtual; abstract;
       Procedure Invalidate; virtual; abstract;
       Procedure Line(X0,Y0,X1,Y1:Integer);  overload; virtual;
       Procedure Line(const FromPoint,ToPoint:TPoint); overload; {$IFDEF D9}inline;{$ENDIF}
       Procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}); overload; virtual; abstract;
       Procedure Polygon(const Points: Array of TPoint); virtual; abstract;
       Procedure PolygonGradient(const Points: Array of TPoint; Gradient:TCustomTeeGradient); virtual;

       procedure RotateLabel( x,y:Integer; Const St:String;
                              RotDegree:Double); virtual; abstract;  // 7.0
       property SupportsFullRotation:Boolean read GetSupportsFullRotation;
       procedure UnClipRectangle; virtual; abstract;

       // properties
       property BackColor:TColor read GetBackColor write SetBackColor;
       property BackMode:TCanvasBackMode read GetBackMode write SetBackMode;
       property Bounds:TRect read FBounds;
       property Brush:TBrush read FBrush;
       property Font:TFont read FFont;
       property FontHeight:Integer read GetFontHeight;
       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;

     // 2D
     TFloatPoint=packed record
     {$IFDEF CLR}
     public
     {$ENDIF}
       X : Double;
       Y : Double;
     end;

     // 3D
     TPoint3DFloat=packed record
     {$IFDEF CLR}
     public
     {$ENDIF}
       X : Double;
       Y : Double;
       Z : Double;
     end;

     TFloatXYZ=class(TPersistent)
     private
       FX       : Double;
       FY       : Double;
       FZ       : Double;

       procedure SetDoubleProperty(var Variable:Double; const Value:Double);
     protected
       FOnChange : TNotifyEvent;

       function Point:TPoint3DFloat;
       Procedure SetX(Const Value:Double);
       Procedure SetY(Const Value:Double);
       Procedure SetZ(Const Value:Double);
     public
       Procedure Assign(Source:TPersistent); override;
       property OnChange:TNotifyEvent read FOnChange write FOnChange;
     published
       property X:Double read FX write SetX;
       property Y:Double read FY write SetY;
       property Z:Double read FZ write SetZ;
     end;

     TPoint3D         =packed record x,y,z:Integer; end;
     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);

     TCanvas3DPlane=(cpX,cpY,cpZ);

     {$IFNDEF D6}
     IInterface=IUnknown;
     {$ENDIF}
     
     TCanvas3D=class {$IFDEF CLR}abstract{$ENDIF} (TTeeCanvas,  IInterface)
     private
       F3DOptions        : TView3DOptions;
       IDisabledRotation : Integer;
     protected
       FIsOrthogonal : Boolean;  // 6.01, moved from private due to RotateTool
       FXCenter      : Integer;
       FYCenter      : Integer;
       FZCenter      : Integer;
       GradientZ     : Integer;  // 7.0, used at TGLCanvas

       // 8.01, used at TFlexCanvas, etc:
       SupportsID    : Boolean;

       procedure BeginEntity(const Entity:String); virtual;
       procedure EndEntity; virtual;

       procedure CalcPieAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4:Integer; var Theta,Theta2:Extended);
       Function GetPixel3D(X,Y,Z:Integer):TColor; virtual; abstract;
       Function GetSupports3DText:Boolean; virtual; abstract;
       procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); virtual; abstract;

       // IInterface
       {$IFNDEF CLR}
       function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
       function _AddRef: Integer; stdcall;
       function _Release: Integer; stdcall;
       {$ENDIF}
     public
       RotationCenter : TPoint3DFloat;

       { 3d }
       Function CalcRect3D(Const R:TRect; Z:Integer):TRect;
       Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); overload; virtual; abstract;
       Function Calculate3DPosition(const P:TPoint3D):TPoint; overload; {$IFDEF 10}inline;{$ENDIF} // 7.0
       Function Calculate3DPosition(P:TPoint; z:Integer):TPoint; overload; {$IFDEF 10}inline;{$ENDIF}
       Function Calculate3DPosition(x,y,z:Integer):TPoint; overload; virtual; abstract;
       function Calc3DPoints(const Points:Array of TPoint; z:Integer):TPointArray;

       // Changed from "function" to "procedure" in v7.07 (BCB compatibility)
       procedure FourPointsFromRect(Const R:TRect; Z:Integer; var P: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 ABounds,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); overload;
       Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
                        ArrowWidth,ArrowHeight,Z:Integer;
                        const ArrowPercent:Double); overload; 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=True); overload; virtual; abstract;
       Procedure Cube( const R:TRect; Z0,Z1:Integer;
                       DarkSides:Boolean=True); overload;

       procedure Cylinder( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                           Dark3D:Boolean=True); virtual; abstract;
       procedure DisableRotation; virtual;
       procedure EllipseWithZ(const Rect:TRect; Z: Integer); overload;
       procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); overload; virtual; abstract;
       procedure EnableRotation; virtual;
       Procedure HorizLine3D(Left,Right,Y,Z:Integer); virtual;
       Procedure VertLine3D(X,Top,Bottom,Z:Integer); virtual;
       Procedure ZLine3D(X,Y,Z0,Z1:Integer); virtual;
       procedure FrontPlaneBegin; virtual;
       procedure FrontPlaneEnd; virtual;
       Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer);  overload; virtual;
       Procedure LineWithZ(const FromPoint,ToPoint:TPoint; Z:Integer); overload;
       procedure MoveTo3D(X,Y,Z:Integer); overload; virtual;
       procedure MoveTo3D(const P:TPoint3D); overload;
       procedure LineTo3D(X,Y,Z:Integer); overload; virtual;
       procedure LineTo3D(const P:TPoint3D); overload;
       procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
                        Const StartAngle,EndAngle:Double;
                        DarkSides,DrawSides:Boolean;
                        DonutPercent:Integer=0;
                        Gradient:TCustomTeeGradient=nil); 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 Polygon3D(const Points: Array of TPoint3D); virtual; abstract;
       procedure PolygonWithZ(const Points: Array of TPoint; Z:Integer); virtual;
       procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}; Z:Integer); overload; virtual;
       procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
                          DarkSides:Boolean=True); virtual; abstract;
       Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
                              TruncX,TruncZ:Integer); virtual; abstract;
       Procedure Rectangle(Const R:TRect; Z:Integer); overload;
       Procedure Rectangle(X0,Y0,X1,Y1,Z:Integer); {$IFDEF 10}inline;{$ENDIF} overload;
       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:Double); virtual; abstract;  // 7.0
       procedure Sphere(x,y,z:Integer; Const Radius:Double); overload; virtual; abstract;
       procedure StretchDraw(const Rect: TRect; Graphic: TGraphic; Pos:Integer;
                             Plane:TCanvas3DPlane=cpZ); 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 View3DOptions:TView3DOptions read F3DOptions write F3DOptions;
       property XCenter:Integer read FXCenter write FXCenter;
       property YCenter:Integer read FYCenter write FYCenter;
       property ZCenter:Integer read FZCenter write FZCenter;
     end;

     TTrianglePoints  =Array[0..2] of TPoint;
     TCirclePoints    =Array[0..NumCirclePoints-1] of TPoint;

     TTeeCanvas3D=class(TCanvas3D)
     private
       s1              : Extended;
       s2              : Extended;
       s3              : Extended;
       c1              : Extended;
       c2              : Extended;
       c3              : Extended;

       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;

       IHasPerspec     : Boolean;
       IHasTilt        : 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;

       IKeepBitmap      : Boolean;
       IPoints          : TFourPoints;

       CharacterAngle   : Double;  // 8.0
       XCenterOffset    : Integer;
       YCenterOffset    : Integer;

       { 2d }
       function GetBackColor:TColor; override;
       Function GetBackMode:TCanvasBackMode; override;
       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 SetBackColor(Color:TColor); override;
       Procedure SetBackMode(Mode:TCanvasBackMode); override;
       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); {$IFDEF D9}inline;{$ENDIF}
       Function Calc3DTPoint3D(Const P:TPoint3D):TPoint; {$IFDEF D9}inline;{$ENDIF}
       Procedure Calc3DPoint(Var P:TPoint; x,y,z:Integer); overload; {$IFDEF D10}inline;{$ENDIF}
       Procedure Calc3DPoint(Var P:TPoint; x,y:Double; z:Integer); overload;

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

       Procedure CalcPerspective(const Rect:TRect);

       {$IFNDEF CLR}
       Procedure CalcTrigValues;
       {$ENDIF}

     public
       { public }
       Constructor Create;
       Destructor Destroy; override;

       {$IFDEF CLR}
       Procedure CalcTrigValues;
       {$ENDIF}

       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(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: 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 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 DisableRotation; override;
       procedure EnableRotation; override;
       Procedure GradientFill( Const Rect:TRect;
                               StartColor,EndColor:TColor;
                               Direction:TGradientDirection;
                               Balance:Integer=50); override;
       Procedure Invalidate; override;