tecanvas.pas

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

{**********************************************}
{   TeeChart and TeeTree TCanvas3D component   }
{   Copyright (c) 1999-2003 by David Berneda   }
{        All Rights Reserved                   }
{**********************************************}
unit TeCanvas;
{$I TeeDefs.inc}

interface

{.$DEFINE TEEBITMAPSPEED}  // By-pass VCL Canvas bitmap

Uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}
     Classes, SysUtils,
     {$IFDEF CLX}
     Qt, QGraphics, QStdCtrls, QControls, QComCtrls, Types,
     {$ELSE}
     Controls, Graphics, StdCtrls,
     {$ENDIF}
     TypInfo;

Const TeePiStep:Double      = Pi/180.0;

      {$NODEFINE TeePiStep}  { for C++ Builder }

      TeeDefaultPerspective = 15;
      TeeMinAngle           = 270;

      {$IFNDEF D6}
      clMoneyGreen = TColor($C0DCC0);
      clSkyBlue    = TColor($F0CAA6);
      clCream      = TColor($F0FBFF);
      clMedGray    = TColor($A4A0A0);
      {$ENDIF}

      {$IFDEF CLX}
      clMoneyGreen = TColor($C0DCC0);
      clSkyBlue    = TColor($F0CAA6);
      clCream      = TColor($F0FBFF);
      clMedGray    = TColor($A4A0A0);

      TA_LEFT = 0;
      TA_RIGHT = 2;
      TA_CENTER = 6;
      TA_TOP = 0;
      TA_BOTTOM = 8;

      PATCOPY      = 0;
      {$ENDIF}

var
      TeeDefaultConePercent : Integer=0;

type
     {$IFDEF CLX}

     // Fake class to support TUpDown in CLX
     // Inherits from CLX TSpinEdit control.
       
     TUDBtnType=(btNext, btPrev);
     TUDOrientation=(udHorizontal, udVertical);

     TUpDown=class(TSpinEdit)
     private
       FAssociate   : TComponent;
       FOrientation : TUDOrientation;
       FThousands   : Boolean;

       IChangingText : Boolean;
       OldChanged    : TNotifyEvent;
       Procedure DoChangeEdit;
       Procedure ChangedEdit(Sender:TObject);
       Procedure GetOldChanged;
       function GetPosition: Integer;
       procedure SetPosition(const AValue: Integer);
       procedure SetAssociate(const AValue: TComponent);
     protected
       procedure Change(AValue: Integer); override;
       Procedure Loaded; override;
     public
       Constructor Create(AOwner:TComponent); override;
     published
       property Associate:TComponent read FAssociate write SetAssociate;
       property Orientation: TUDOrientation read FOrientation write FOrientation default udVertical;
       property Position:Integer read GetPosition write SetPosition default 0;
       property Thousands: Boolean read FThousands write FThousands default True;
     end;
     {$ENDIF}

     TPenEndStyle=(esRound,esSquare,esFlat);

     TChartPen=class(TPen)
     private
       FEndStyle  : TPenEndStyle;
       FSmallDots : Boolean;
       FVisible   : Boolean;
       Function IsEndStored:Boolean;
       Function IsVisibleStored:Boolean;
       procedure SetEndStyle(const Value: TPenEndStyle);
       Procedure SetSmallDots(Value:Boolean);
       Procedure SetVisible(Value:Boolean);
     protected
       DefaultEnd : TPenEndStyle;
       DefaultVisible : Boolean;
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
       Procedure Assign(Source:TPersistent); override;
     published
       property EndStyle:TPenEndStyle read FEndStyle write SetEndStyle stored IsEndStored;
       property SmallDots:Boolean read FSmallDots write SetSmallDots default False;
       property Visible:Boolean read FVisible write SetVisible stored IsVisibleStored;
     end;

     TChartHiddenPen=class(TChartPen)
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
     published
       property Visible default False;
     end;

     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;

     TChartAxisPen=class(TChartPen)
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
     published
       property Width default 2;
     end;

     TChartBrush=class(TBrush)
     private
       FImage : TPicture;
       Function GetImage:TPicture;
       procedure SetImage(Value:TPicture);
     public
       Constructor Create(OnChangeEvent:TNotifyEvent);
       Destructor Destroy; override;
       Procedure Assign(Source:TPersistent); override;
     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;
       FHorizOffset : Integer;
       FOrthogonal  : Boolean;
       FOrthoAngle  : Integer;
       FPerspective : Integer;
       FRotation    : Integer;
       FTilt        : Integer;
       FVertOffset  : Integer;
       FZoom        : Integer;
       FZoomText    : Boolean;
       FOnScrolled  : TTeeView3DScrolled;
       FOnChangedZoom:TTeeView3DChangedZoom;

       FParent      : TWinControl;
       Procedure SetElevation(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(AParent:TWinControl);
       Procedure Repaint;
       Procedure Assign(Source:TPersistent); override;
       property Parent:TWinControl read FParent write FParent;
       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 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;
     TCanvas3D=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;

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

       IOnChange     : TNotifyEvent;
       IBlend        : TTeeBlend;

       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 SetTransparency(Value: TTeeTransparency);
       Procedure SetVertSize(Value:Integer);
     protected
       DefaultColor : TColor;
       DefaultSize  : Integer;
     public
       Constructor Create(AOnChange:TNotifyEvent);
       Procedure Assign(Source:TPersistent); override;
       procedure Draw(ACanvas:TCanvas3D; Const Rect:TRect);
       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 Transparency:TTeeTransparency read FTransparency write SetTransparency default 0;
       property VertSize:Integer read FVertSize write SetVertSize stored IsVertStored;
     end;

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

     TGradientDirection = (gdTopBottom, gdBottomTop,
                           gdLeftRight, gdRightLeft,
                           gdFromCenter, gdFromTopLeft,
                           gdFromBottomLeft, gdRadial );

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

       IChanged   : TNotifyEvent;
       IHasMiddle : Boolean;
       Procedure DrawRadial(Canvas:TTeeCanvas; Rect:TRect);
       Function GetMidColor:TColor;
       Procedure SetBalance(Value:Integer);
       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);
     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;
       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;

     TPointArray      =Array of TPoint;

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

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

     TTeeCanvas=class
     private
       FCanvas     : TCanvas;
       FFont       : TFont;
       FPen        : TPen;
       FBrush      : TBrush;
       FMetafiling : Boolean;

       ITransp       : Integer;
       Procedure InternalDark(Const AColor:TColor; Quantity:Byte);
     protected