tecanvas.pas

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

     TDottedGrayPen=class(TChartPen)
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
     published
       property Color default clGray;
       property Style default psDot;
     end;

     TDarkGrayPen=class(TChartPen)
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
     published
       property Color default clDkGray;
     end;

     TWhitePen=class(TChartPen)
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
     published
       property Color default clWhite;
     end;

     TChartBrush=class(TBrush)
     private
       FImage : TPicture;
       Function GetImage:TPicture;
       procedure SetImage(const Value:TPicture);
     public
       Constructor Create(OnChangeEvent:TNotifyEvent); virtual;
       Destructor Destroy; override;

       Procedure Assign(Source:TPersistent); override;
       Procedure Clear;
     published
       property Color default clDefault;
       property Image:TPicture read GetImage write SetImage;
     end;

     TTeeView3DScrolled=procedure(IsHoriz:Boolean) of object;
     TTeeView3DChangedZoom=procedure(NewZoom:Integer) of object;

     TView3DOptions = class(TPersistent)
     private
       FElevation   : Integer;
       FFontZoom    : Integer;
       FHorizOffset : Integer;
       FOrthogonal  : Boolean;
       FOrthoAngle  : Integer;
       FPerspective : Integer;
       FRotation    : Integer;
       FTilt        : Integer;
       FVertOffset  : Integer;
       FZoom        : Integer;
       FZoomText    : Boolean;
       FOnScrolled  : TTeeView3DScrolled;
       FOnChangedZoom:TTeeView3DChangedZoom;

       {$IFDEF TEEVCL}
       FParent      : TWinControl;
       {$ENDIF}

       Procedure SetElevation(Value:Integer);
       Procedure SetFontZoom(Value:Integer);
       Procedure SetPerspective(Value:Integer);
       Procedure SetRotation(Value:Integer);
       Procedure SetTilt(Value:Integer);
       Procedure SetHorizOffset(Value:Integer);
       Procedure SetVertOffset(Value:Integer);
       Procedure SetOrthoAngle(Value:Integer);
       Procedure SetOrthogonal(Value:Boolean);
       Procedure SetZoom(Value:Integer);
       Procedure SetZoomText(Value:Boolean);
       Procedure SetBooleanProperty(Var Variable:Boolean; Value:Boolean);
       Procedure SetIntegerProperty(Var Variable:Integer; Value:Integer);
     protected
       function CalcOrthoRatio:Double;
     public
       Constructor Create({$IFDEF TEEVCL}AParent:TWinControl{$ENDIF});
       Procedure Repaint;
       Procedure Assign(Source:TPersistent); override;

       {$IFDEF TEEVCL}
       property Parent:TWinControl read FParent write FParent;
       {$ENDIF}

       property OnChangedZoom:TTeeView3DChangedZoom read FOnChangedZoom
                                                    write FOnChangedZoom;
       property OnScrolled:TTeeView3DScrolled read FOnScrolled write FOnScrolled;
     published
       property Elevation:Integer read FElevation write SetElevation default 345;
       property FontZoom:Integer read FFontZoom write SetFontZoom default 100;
       property HorizOffset:Integer read FHorizOffset write SetHorizOffset default 0;
       property OrthoAngle:Integer read FOrthoAngle write SetOrthoAngle default 45;
       property Orthogonal:Boolean read FOrthogonal write SetOrthogonal default True;
       property Perspective:Integer read FPerspective
                                    write SetPerspective default TeeDefaultPerspective;
       property Rotation:Integer read FRotation write SetRotation default 345;
       property Tilt:Integer read FTilt write SetTilt default 0;
       property VertOffset:Integer read FVertOffset write SetVertOffset default 0;
       property Zoom:Integer read FZoom write SetZoom default 100;
       property ZoomText:Boolean read FZoomText write SetZoomText default True;
     end;

     TTeeCanvas=class;

     TTeeTransparency=0..100;

     TTeeBlend=class
     private
       FBitmap : TBitmap;
       FCanvas : TTeeCanvas;
       FRect   : TRect;

       IValidSize : Boolean;
     public
       Constructor Create(ACanvas:TTeeCanvas; Const R:TRect);
       Destructor Destroy; override;

       Procedure DoBlend(Transparency:TTeeTransparency);
       Procedure SetRectangle(Const R:TRect);
     end;

     TCanvas3D=class;

     TTeeShadow=class(TPersistent)
     private
       FColor        : TColor;
       FHorizSize    : Integer;
       FSmooth       : Boolean;
       FTransparency : TTeeTransparency;
       FVertSize     : Integer;

       IOnChange     : TNotifyEvent;
       IBlend        : TTeeBlend;

       procedure Changed;
       procedure FinishBlending(ACanvas:TTeeCanvas);
       function GetSize: Integer;
       function IsColorStored: Boolean;
       function IsHorizStored: Boolean;
       function IsVertStored: Boolean;
       Function PrepareCanvas(ACanvas:TCanvas3D; const R:TRect;
                              Z:Integer=0):Boolean;
       Procedure SetColor(Value:TColor);
       Procedure SetHorizSize(Value:Integer);
       Procedure SetIntegerProperty(Var Variable:Integer; Const Value:Integer);
       procedure SetSize(const Value: Integer);
       procedure SetSmooth(const Value: Boolean);
       procedure SetTransparency(Value: TTeeTransparency);
       Procedure SetVertSize(Value:Integer);

     {$IFDEF CLR}
     public
     {$ELSE}
     protected
     {$ENDIF}
       DefaultColor : TColor;
       DefaultSize  : Integer;
     public
       Constructor Create(AOnChange:TNotifyEvent);
       Procedure Assign(Source:TPersistent); override;
       procedure Draw(ACanvas:TCanvas3D; Const Rect:TRect); overload;
       procedure Draw(ACanvas:TCanvas3D; Const Rect:TRect; Z:Integer); overload;
       procedure DrawEllipse(ACanvas:TCanvas3D; Const Rect:TRect; Z:Integer=0);
       property Size:Integer read GetSize write SetSize;
     published
       property Color:TColor read FColor write SetColor stored IsColorStored;
       property HorizSize:Integer read FHorizSize write SetHorizSize stored IsHorizStored;
       property Smooth:Boolean read FSmooth write SetSmooth default True;  // 7.0
       property Transparency:TTeeTransparency read FTransparency write SetTransparency default 0;
       property VertSize:Integer read FVertSize write SetVertSize stored IsVertStored;
     end;

     TFourPoints=Array[0..3] of TPoint;
     TPointArray=Array of TPoint;

     TGradientDirection = (gdTopBottom, gdBottomTop,
                           gdLeftRight, gdRightLeft,
                           gdFromCenter, gdFromTopLeft,
                           gdFromBottomLeft, gdRadial,
                           gdDiagonalUp, gdDiagonalDown );  // 7.0

     TCustomTeeGradient=class(TPersistent)
     private
       FBalance    : Integer;
       FDirection  : TGradientDirection;
       FEndColor   : TColor;
       FMidColor   : TColor;
       FRadialX    : Integer;
       FRadialY    : Integer;
       FStartColor : TColor;
       FVisible    : Boolean;

       IHasMiddle : Boolean;
       Procedure DrawRadial(Canvas:TTeeCanvas; Rect:TRect);
       Function GetMidColor:TColor;
       Procedure SetBalance(Value:Integer);
       Procedure SetColorProperty(Var Variable:TColor; const Value:TColor);
       Procedure SetDirection(Value:TGradientDirection);
       Procedure SetEndColor(Value:TColor);
       Procedure SetIntegerProperty(Var Variable:Integer; Value:Integer);
       Procedure SetMidColor(Value:TColor);
       procedure SetRadialX(const Value: Integer);
       procedure SetRadialY(const Value: Integer);
       Procedure SetStartColor(Value:TColor);
       Procedure SetVisible(Value:Boolean);
     protected
       IChanged   : TNotifyEvent;
       procedure DoChanged;
     public
       Constructor Create(ChangedEvent:TNotifyEvent); virtual;
       Procedure Assign(Source:TPersistent); override;
       Procedure Draw(Canvas:TTeeCanvas; Const Rect:TRect; RoundRectSize:Integer=0); overload;
       Procedure Draw(Canvas:TTeeCanvas; var P:TFourPoints); overload;
       Procedure Draw(Canvas:TCanvas3D; var P:TFourPoints; Z:Integer); overload;
       procedure Draw(Canvas:TCanvas3D; var P:TPointArray; Z:Integer; Is3D:Boolean); overload; // 7.0
       property Changed:TNotifyEvent read IChanged write IChanged;
       Procedure UseMiddleColor;

       { to be published }
       property Balance:Integer read FBalance write SetBalance default 50;
       property Direction:TGradientDirection read FDirection write SetDirection default gdTopBottom;
       property EndColor:TColor read FEndColor write SetEndColor default clYellow;
       property MidColor:TColor read GetMidColor write SetMidColor default clNone;
       property RadialX:Integer read FRadialX write SetRadialX default 0;
       property RadialY:Integer read FRadialY write SetRadialY default 0;
       property StartColor:TColor read FStartColor write SetStartColor default clWhite;
       property Visible:Boolean read FVisible write SetVisible default False;
     end;

     TTeeGradient=class(TCustomTeeGradient)
     published
       property Balance;
       property Direction;
       property EndColor;
       property MidColor;
       property RadialX;
       property RadialY;
       property StartColor;
       property Visible;
     end;

     TTeeFontGradient=class(TTeeGradient)
     private
       FOutline : Boolean;

       Procedure SetBooleanProperty( Var Variable:Boolean;
                                     Const Value:Boolean);
       procedure SetOutline(const Value: Boolean);
     published
       property Outline:Boolean read FOutline write SetOutline default False;
     end;

     TTeeFont=class(TFont)
     private
       FGradient      : TTeeFontGradient;
       FInterCharSize : Integer;
       FOutLine       : TChartHiddenPen;
       FShadow        : TTeeShadow;

       ICanvas        : TTeeCanvas;
       function GetGradient: TTeeFontGradient;
       function GetOutLine: TChartHiddenPen;
       Function GetShadow: TTeeShadow;
       Function IsColorStored:Boolean;
       Function IsHeightStored:Boolean;
       Function IsNameStored:Boolean;
       Function IsStyleStored:Boolean;
       Procedure SetInterCharSize(Value:Integer);
       Procedure SetOutLine(Value:TChartHiddenPen);
       Procedure SetShadow(Value:TTeeShadow);
       procedure SetGradient(const Value: TTeeFontGradient);
     protected
       IDefColor : TColor;
       IDefStyle : TFontStyles;
     public
       Constructor Create(ChangedEvent:TNotifyEvent);
       Destructor Destroy; override;
       Procedure Assign(Source:TPersistent); override;
     published
       {$IFNDEF CLX}
       property Charset default DEFAULT_CHARSET;
       {$ENDIF}
       property Color stored IsColorStored;
       property Gradient:TTeeFontGradient read GetGradient write SetGradient;
       property Height stored IsHeightStored;
       property InterCharSize:Integer read FInterCharSize
                                      write SetInterCharSize default 0;
       property Name stored IsNameStored;
       property OutLine:TChartHiddenPen read GetOutLine write SetOutLine;
       {$IFDEF CLX}
       property Pitch default fpVariable;
       {$ENDIF}
       property Shadow:TTeeShadow read GetShadow write SetShadow;
       property Style stored IsStyleStored;
       {$IFDEF CLX}
       property Weight default 40;
       {$ENDIF}
     end;

     TCanvasBackMode  = ( cbmNone,cbmTransparent,cbmOpaque );
     TCanvasTextAlign = Integer;

     TTeeCanvasHandle={$IFDEF CLX}QPainterH{$ELSE}HDC{$ENDIF};

     TTeeCanvas=class {$IFDEF CLR}abstract{$ENDIF}
     private
       FCanvas     : TCanvas;
       FFont       : TFont;
       FPen        : TPen;
       FBrush      : TBrush;

       FMetafiling : Boolean;
       ITransp     : Integer;

       Function GetFontHeight:Integer; {$IFDEF D10}inline;{$ENDIF} // 7.0
       Procedure InternalDark(Const AColor:TColor; Quantity:Byte);
     protected
       FBounds     : TRect;  // 7.0, moved from TeeCanvas3D
       IFont       : TTeeFont;

       Procedure SetCanvas(ACanvas:TCanvas);

       function GetBackColor:TColor; virtual; abstract;
       Function GetBackMode:TCanvasBackMode; virtual; abstract;
       Function GetHandle:TTeeCanvasHandle; virtual; abstract;
       Function GetMonochrome:Boolean; virtual; abstract;
       Function GetPixel(x,y:Integer):TColor; virtual; abstract;
       Function GetSupportsFullRotation:Boolean; virtual; abstract;
       Function GetTextAlign:TCanvasTextAlign; virtual; abstract;
       Function GetUseBuffer:Boolean; virtual; abstract;
       Procedure SetBackColor(Color:TColor); virtual; abstract;
       Procedure SetBackMode(Mode:TCanvasBackMode); virtual; abstract;
       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); {$IFDEF D10}inline;{$ENDIF}
       Procedure AssignBrushColor(ABrush:TChartBrush; AColor,ABackColor:TColor);
       procedure AssignVisiblePen(APen:TPen); {$IFDEF D10}inline;{$ENDIF}
       procedure AssignVisiblePenColor(APen:TPen; AColor:TColor); virtual; // 7.0
       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; {$IFDEF D9}inline;{$ENDIF}
       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;
       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; {$IFDEF D9}inline;{$ENDIF}
       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; AllowHtml:Boolean); overload;
       Procedure TextOut(X,Y:Integer; const Text:String); overload; virtual; abstract;
       Function TextWidth(Const St:String):Integer; virtual;
       Function TextHeight(Const St:String):Integer; virtual;

       { 2d extra }
       procedure ClipRectangle(Const Rect:TRect); overload; virtual; abstract;
       Procedure ClipRectangle(Const Rect:TRect; RoundSize:Integer); overload; virtual;
       Procedure ClipEllipse(Const Rect:TRect; Inverted:Boolean=False); virtual;
       Procedure ClipPolygon(Var Points:Array of TPoint; NumPoints:Integer); virtual;

       // Returns modified Points array with sorted points that define
       // biggest convex polygon.
       // Written by Peter Bone : [e-mail]
       function ConvexHull(var Points : TPointArray) : Boolean;

       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 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 RotateLabel( x,y:Integer; Const St:String;
                              RotDegree:Double); virtual; abstract;  // 7.0