tecanvas.pas

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

       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;

     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);

     TCanvas3D=class {$IFDEF CLR}abstract{$ENDIF} (TTeeCanvas)
     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

       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;
     public
       RotationCenter : TPoint3DFloat;

       { 3d }
       Function CalcRect3D(Const R:TRect; Z:Integer):TRect;
       Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); 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 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 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); virtual; abstract;
       procedure DisableRotation; virtual;
       procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); virtual; abstract;
       procedure EnableRotation; virtual;
       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 FrontPlaneBegin; virtual;
       procedure FrontPlaneEnd; virtual;
       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); overload; virtual; abstract;
       procedure MoveTo3D(const P:TPoint3D); overload;  // 7.0
       procedure LineTo3D(X,Y,Z:Integer); overload; virtual; abstract;
       procedure LineTo3D(const P:TPoint3D); overload;  // 7.0
       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 PolygonWithZ(const Points: Array of TPoint; Z:Integer); virtual; abstract;
       procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}; 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 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); 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 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
       FXCenterOffset  : Integer;
       FYCenterOffset  : Integer;

       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;
       IPoints          : TFourPoints;

       { 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;
       function Calc3DPoints(const Points:Array of TPoint; z:Integer):TPointArray;

       Procedure CalcPerspective(const Rect:TRect);

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

     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;

       {$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(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 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 DoHorizLine(X0,X1,Y:Integer); override;
       Procedure DoVertLine(X,Y0,Y1:Integer); override;
       procedure EnableRotation; 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;
       Procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}); overload; override;
       Procedure Polygon(const Points: Array of TPoint); override;
       procedure RotateLabel(x,y:Integer; const St:String; RotDegree:Double); override;
       procedure RotateLabel3D( x,y,z:Integer;
                                const St:String; RotDegree:Double); override;
       procedure UnClipRectangle; override;

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

       Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
                        ArrowWidth,ArrowHeight,Z:Integer;
                        const ArrowPercent:Double); 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=True); 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 GetCirclePoints(var P:{$IFDEF D5}TCirclePoints{$ELSE}TPointArray{$ENDIF}; X1, Y1, X2, Y2, Z: Integer);
       Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); override;
       Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); 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( AXCenter,AYCenter,XRadius,YRadius,Z0,Z1:Integer;
                        Const StartAngle,EndAngle:Double;
                        DarkSides,DrawSides:Boolean; DonutPercent:Integer=0;
                        Gradient:TCustomTeeGradient=nil); 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(const Points: Array of TPoint; Z:Integer); override;
       procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}; Z:Integer); overload; 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 write FBitmap; // 7.02 rw
     end;

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

Function Point3D(const x,y,z:Integer):TPoint3D; {$IFDEF D9}inline;{$ENDIF}

Procedure SwapDouble(Var a,b:Double); {$IFDEF D10}inline;{$ENDIF}   { exchanges a and b }
Procedure SwapInteger(Var a,b:Integer); {$IFDEF D10}inline;{$ENDIF} { exchanges a and b }

Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Integer); {$IFDEF D9}inline;{$ENDIF}
Procedure RectCenter(Const R:TRect; Var X,Y:Integer); {$IFDEF D9}inline;{$ENDIF}
Function RectFromPolygon(Const Points:Array of TPoint; NumPoints:Integer):TRect;
Function RectFromTriangle(Const Points:TTrianglePoints):TRect; {$IFDEF D9}inline;{$ENDIF}

Procedure ClipCanvas(ACanvas:TCanvas; Const Rect:TRect);
Procedure UnClipCanvas(ACanvas:TCanvas);

// These Clipxxx routines are now deprecated...
// Use TTeeCanvas.Clipxxx equivalent methods.
Procedure ClipEllipse(ACanvas:TTeeCanvas; Const Rect:TRect); {$IFDEF D10}inline;{$ENDIF}
Procedure ClipRoundRectangle(ACanvas:TTeeCanvas; Const Rect:TRect; RoundSize:Integer); {$IFDEF D10}inline;{$ENDIF}
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;

{$IFDEF TEEVCL}
type
  TButtonGetColorProc=function:TColor of object;

  TTeeButton = class(TButton)
  private
    {$IFNDEF CLX}
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    {$ENDIF}
  protected
    Instance : TObject;
    Info     : {$IFDEF CLR}TPropInfo{$ELSE}PPropInfo{$ENDIF};

    Procedure DrawSymbol(ACanvas:TTeeCanvas); virtual; // abstract;

    {$IFNDEF CLX}
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    {$IFDEF TEEWINDOWS}