home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Src Code / TECANVAS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  83.2 KB  |  3,118 lines
  1. {**********************************************}
  2. {   TeeChart and TeeTree TCanvas3D component   }
  3. {   Copyright (c) 1998 by David Berneda        }
  4. {        All Rights Reserved                   }
  5. {**********************************************}
  6. {$I teedefs.inc}
  7. unit TeCanvas;
  8. {$P-}
  9.  
  10. {.$DEFINE TEEPERF}               { creates a text file with speed timing values }
  11. {.$DEFINE TEEGRAPHLIST}          { creates a graph list }
  12. {.$DEFINE TEEUSEDRAWDIB}         { uses DIB bitmaps }
  13. {.$DEFINE MONITOR_BUFFERREDRAWS} { displays buffer drawing counters }
  14.  
  15. interface
  16.  
  17. Uses {$IFDEF D1}
  18.      WinProcs,WinTypes,
  19.      {$ELSE}
  20.      Windows,   { <--- because BCB3 "Illegal EXTDEF fixup bug }
  21.      {$ENDIF}
  22.      Classes,Controls,Graphics,SysUtils{$IFDEF TEEPERF},MMSystem{$ENDIF}
  23.      {$IFDEF TEEUSEDRAWDIB}
  24.      ,MMSystem
  25.      {$ENDIF}
  26.      ;
  27.  
  28. Const TeePiStep=(Pi/180.0);
  29.  
  30. type { Several specialized Pen classes }
  31.      TChartPen=class(TPen)
  32.      private
  33.        FSmallDots : Boolean;
  34.        FVisible   : Boolean;
  35.        Procedure SetVisible(Value:Boolean);
  36.        Procedure SetSmallDots(Value:Boolean);
  37.      public
  38.        Constructor Create(OnChangeEvent:TNotifyEvent);
  39.        Procedure Assign(Source:TPersistent); override;
  40.      published
  41.        property SmallDots:Boolean read FSmallDots write SetSmallDots default False;
  42.        property Visible:Boolean read FVisible write SetVisible default True;
  43.      end;
  44.  
  45.      TChartHiddenPen=class(TChartPen)
  46.      public
  47.        Constructor Create(OnChangeEvent:TNotifyEvent);
  48.      published
  49.        property Visible default False;
  50.      end;
  51.  
  52.      TDottedGrayPen=class(TChartPen)
  53.      public
  54.        Constructor Create(OnChangeEvent:TNotifyEvent);
  55.      published
  56.        property Color default clGray;
  57.        property Style default psDot;
  58.      end;
  59.  
  60.      TDarkGrayPen=class(TChartPen)
  61.      public
  62.        Constructor Create(OnChangeEvent:TNotifyEvent);
  63.      published
  64.        property Color default clDkGray;
  65.      end;
  66.  
  67.      TChartArrowPen=class(TChartPen)
  68.      public
  69.        Constructor Create(OnChangeEvent:TNotifyEvent);
  70.      published
  71.        property Color default clWhite;
  72.      end;
  73.  
  74.      TChartAxisPen=class(TChartPen)
  75.      public
  76.        Constructor Create(OnChangeEvent:TNotifyEvent);
  77.      published
  78.        property Width default 2;
  79.      end;
  80.  
  81.      TTeeView3DScrolled=procedure(IsHoriz:Boolean) of object;
  82.      TTeeView3DChangedZoom=procedure(NewZoom:Integer) of object;
  83.  
  84.      TView3DOptions = class(TPersistent)
  85.      private
  86.        FElevation   : Integer;
  87.        FHorizOffset : Integer;
  88.        FOrthogonal  : Boolean;
  89.        FPerspective : Integer;
  90.        FRotation    : Integer;
  91.        FTilt        : Integer;
  92.        FVertOffset  : Integer;
  93.        FZoom        : Integer;
  94.        FZoomText    : Boolean;
  95.        FOnScrolled  : TTeeView3DScrolled;
  96.        FOnChangedZoom:TTeeView3DChangedZoom;
  97.  
  98.        FParent      : TWinControl;
  99.        Procedure SetElevation(Value:Integer);
  100.        Procedure SetPerspective(Value:Integer);
  101.        Procedure SetRotation(Value:Integer);
  102.        Procedure SetTilt(Value:Integer);
  103.        Procedure SetHorizOffset(Value:Integer);
  104.        Procedure SetVertOffset(Value:Integer);
  105.        Procedure SetOrthogonal(Value:Boolean);
  106.        Procedure SetZoom(Value:Integer);
  107.        Procedure SetZoomText(Value:Boolean);
  108.        Procedure SetBooleanProperty(Var Variable:Boolean; Value:Boolean);
  109.        Procedure SetIntegerProperty(Var Variable:Integer; Value:Integer);
  110.      public
  111.        Constructor Create(AParent:TWinControl);
  112.        Procedure Repaint;
  113.        Procedure Assign(Source:TPersistent); override;
  114.        property Parent:TWinControl read FParent write FParent;
  115.        property OnChangedZoom:TTeeView3DChangedZoom read FOnChangedZoom
  116.                                                     write FOnChangedZoom;
  117.        property OnScrolled:TTeeView3DScrolled read FOnScrolled write FOnScrolled;
  118.      published
  119.        property Elevation:Integer read FElevation write SetElevation default 345;
  120.        property HorizOffset:Integer read FHorizOffset write SetHorizOffset default 0;
  121.        property Orthogonal:Boolean read FOrthogonal write SetOrthogonal default True;
  122.        property Perspective:Integer read FPerspective write SetPerspective default 15;
  123.        property Rotation:Integer read FRotation write SetRotation default 345;
  124.        property Tilt:Integer read FTilt write SetTilt default 0;
  125.        property VertOffset:Integer read FVertOffset write SetVertOffset default 0;
  126.        property Zoom:Integer read FZoom write SetZoom default 100;
  127.        property ZoomText:Boolean read FZoomText write SetZoomText default True;
  128.      end;
  129.  
  130.      TCanvasBackMode  = ( cbmNone,cbmTransparent,cbmOpaque );
  131.      TCanvasTextAlign = Integer;  { TA_LEFT, TA_CENTER, TA_RIGHT }
  132.  
  133.      TGradientDirection=( gdTopBottom,
  134.                           gdBottomTop,
  135.                           gdLeftRight,
  136.                           gdRightLeft,
  137.                           gdFromCenter,
  138.                           gdFromTopLeft,
  139.                           gdFromBottomLeft );
  140.  
  141.      TTeeCanvas=class
  142.      private
  143.        FCanvas     : TCanvas;
  144.        FFont       : TFont;
  145.        FPen        : TPen;
  146.        FBrush      : TBrush;
  147.        FMetafiling : Boolean;
  148.      protected
  149.        Procedure SetCanvas(ACanvas:TCanvas);
  150.  
  151.        function GetBackColor:TColor; virtual; abstract;
  152.        Function GetBackMode:TCanvasBackMode; virtual; abstract;
  153.        Function GetHandle:HDC; virtual; abstract;
  154.        Function GetMonochrome:Boolean; virtual; abstract;
  155.        Function GetTextAlign:TCanvasTextAlign; virtual; abstract;
  156.        Function GetUseBuffer:Boolean; virtual; abstract;
  157.  
  158.        Procedure SetBackColor(Color:TColor); virtual; abstract;
  159.        Procedure SetBackMode(Mode:TCanvasBackMode); virtual; abstract;
  160.        Procedure SetMonochrome(Value:Boolean); virtual; abstract;
  161.        procedure SetPixel(X, Y: Integer; Value: TColor); virtual; abstract;
  162.        procedure SetTextAlign(Align:TCanvasTextAlign); virtual; abstract;
  163.        Procedure SetUseBuffer(Value:Boolean); virtual; abstract;
  164.  
  165.      public
  166.        procedure AssignVisiblePen(APen:TChartPen);
  167.        Procedure ResetState;
  168.  
  169.        { 2d }
  170.        procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); virtual; abstract;
  171.        procedure Draw(X, Y: Integer; Graphic: TGraphic); virtual; abstract;
  172.        procedure Ellipse(X1, Y1, X2, Y2: Integer); virtual; abstract;
  173.        procedure FillRect(const Rect: TRect); virtual; abstract;
  174.        procedure Frame3D( Rect: TRect; TopColor,BottomColor: TColor; Width: Integer); virtual; abstract;
  175.        procedure LineTo(X,Y:Integer); virtual; abstract;
  176.        procedure MoveTo(X,Y:Integer); virtual; abstract;
  177.        procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); virtual; abstract;
  178.        procedure Rectangle(X0,Y0,X1,Y1:Integer); virtual; abstract;
  179.        procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); virtual; abstract;
  180.        procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); virtual; abstract;
  181.        Procedure TextOut(X,Y:Integer; const Text:String); virtual; abstract;
  182.        Function TextWidth(Const St:String):Integer; virtual;
  183.        Function TextHeight(Const St:String):Integer; virtual;
  184.        Function FontHeight:Integer;
  185.  
  186.        { 2d extra }
  187.        procedure ClipRectangle(Const Rect:TRect); virtual; abstract;
  188.        Procedure DoHorizLine(X0,X1,Y:Integer); virtual; abstract;
  189.        Procedure DoRectangle(Const Rect:TRect); virtual; abstract;
  190.        Procedure DoVertLine(X,Y0,Y1:Integer); virtual; abstract;
  191.        procedure EraseBackground(const Rect: TRect); virtual; abstract;
  192.        Procedure GradientFill( Const Rect:TRect;
  193.                                StartColor,EndColor:TColor;
  194.                                Direction:TGradientDirection); virtual; abstract;
  195.        Procedure Invalidate; virtual; abstract;
  196.        Procedure Line(X0,Y0,X1,Y1:Integer); virtual; abstract;
  197.        Procedure Polygon(const Points: array of TPoint); virtual; abstract;
  198.        procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Integer); virtual; abstract;
  199.        procedure UnClipRectangle; virtual; abstract;
  200.  
  201.      { properties }
  202.        property BackColor:TColor read GetBackColor write SetBackColor;
  203.        property BackMode:TCanvasBackMode read GetBackMode write SetBackMode;
  204.        property Brush:TBrush read FBrush;
  205.        property Font:TFont read FFont;
  206.        property Handle:HDC read GetHandle;
  207.        property Metafiling:Boolean read FMetafiling write FMetafiling;
  208.        property Monochrome:Boolean read GetMonochrome write SetMonochrome;
  209.        property Pen:TPen read FPen;
  210.        property Pixels[X, Y: Integer]: TColor write SetPixel;
  211.        property ReferenceCanvas:TCanvas read FCanvas write SetCanvas;
  212.        property TextAlign:TCanvasTextAlign read GetTextAlign write SetTextAlign;
  213.        property UseBuffer:Boolean read GetUseBuffer write SetUseBuffer;
  214.      end;
  215.  
  216.      { 3d }
  217.      TPoint3D  = record x,y,z:Integer; end;
  218.      TFourPoints = Array[0..3] of TPoint;
  219.  
  220.      TCanvas3D=class(TTeeCanvas)
  221.      private
  222.        F3DOptions    : TView3DOptions;
  223.        FIsOrthogonal : Boolean;
  224.      protected
  225.        procedure SetPixel3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; Value: TColor); virtual; abstract;
  226.        Function GetSupportsFullRotation:Boolean; virtual; abstract;
  227.        Function GetSupports3DText:Boolean; virtual; abstract;
  228.      public
  229.      { 3d }
  230.        Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); virtual; abstract;
  231.        Function Calculate3DPosition(x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}):TPoint; virtual; abstract;
  232.  
  233.        Function InitWindow( DestCanvas:TCanvas;
  234.                             A3DOptions:TView3DOptions;
  235.                             ABackColor:TColor;
  236.                             Is3D:Boolean;
  237.                             Const UserRect:TRect):TRect; virtual; abstract;
  238.  
  239.        Procedure Assign(Source:TCanvas3D); virtual;
  240.  
  241.        Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); virtual; abstract;
  242.        Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); virtual; abstract;
  243.        Function ReDrawBitmap:Boolean; virtual; abstract;
  244.  
  245.        Procedure Arrow( Filled:Boolean;
  246.                         Const FromPoint,ToPoint:TPoint;
  247.                         ArrowWidth,ArrowHeight,Z:Integer); virtual; abstract;
  248.        procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); virtual; abstract;
  249.        Procedure Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean); virtual; abstract;
  250.        procedure Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer; Dark3D:Boolean); virtual; abstract;
  251.        Procedure HorizLine3D(Left,Right,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  252.        Procedure VertLine3D(X,Top,Bottom,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  253.        Procedure ZLine3D(X,Y,Z0,Z1:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  254.        procedure EllipseWithZ(X1, Y1, X2, Y2, Z: {$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  255.        procedure FrontPlaneBegin; virtual; abstract;
  256.        procedure FrontPlaneEnd; virtual; abstract;
  257.        Procedure LineWithZ(X0,Y0,X1,Y1,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  258.        procedure MoveTo3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  259.        procedure LineTo3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); virtual; abstract;
  260.        procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
  261.                         Const StartAngle,EndAngle:Double;
  262.                         DarkSides,DrawSides:Boolean); virtual; abstract;
  263.        procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); virtual; abstract;
  264.        procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); virtual; abstract;
  265.        procedure PlaneFour3D(Points:TFourPoints; Z0,Z1:Integer); virtual; abstract;
  266.        procedure Pyramid(Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer; DarkSides:Boolean); virtual; abstract;
  267.        Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); virtual; abstract;
  268.        Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); virtual; abstract;
  269.        Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); virtual; abstract;
  270.        procedure RotateLabel3D( x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF};
  271.                                 Const St:String; RotDegree:Integer); virtual; abstract;
  272.        Procedure TextOut3D(x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; const Text:String); virtual; abstract;
  273.        procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); virtual; abstract;
  274.  
  275.        property Pixels3D[X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}]:TColor write SetPixel3D;
  276.        property Supports3DText:Boolean read GetSupports3DText;
  277.        property SupportsFullRotation:Boolean read GetSupportsFullRotation;
  278.        property View3DOptions:TView3DOptions read F3DOptions write F3DOptions;
  279.      end;
  280.  
  281.      TTeeCanvas3D=class(TCanvas3D)
  282.      private
  283.        FXCenter        : Longint;
  284.        FYCenter        : Longint;
  285.        FZCenter        : Longint;
  286.        FXCenterOffset  : Longint;
  287.        FYCenterOffset  : Longint;
  288.  
  289.        s2              : Extended;
  290.        c2s1            : Extended;
  291.        c2s3            : Double;
  292.        c2c3            : Double;
  293.        c2c1            : Double;
  294.        tempXX          : Double;
  295.        tempYX          : Double;
  296.        tempXZ          : Double;
  297.        tempYZ          : Double;
  298.  
  299.        FWas3D          : Boolean;
  300.        FIs3D           : Boolean;
  301.  
  302.        FBitmap         : TBitmap;
  303.        FBufferedDisplay: Boolean;
  304.        FMonochrome     : Boolean;
  305.        FDirty          : Boolean;
  306.  
  307.        FBounds         : TRect;
  308.  
  309.        IZoomText       : Boolean;
  310.        IZoomFactor     : Double;
  311.        IPerspec        : Double;
  312.  
  313.        Procedure TransferBitmap(ALeft,ATop:Integer; ACanvas:TCanvas);
  314.  
  315.      protected
  316.  
  317.        { 2d }
  318.        function GetBackColor:TColor; override;
  319.        Function GetBackMode:TCanvasBackMode; override;
  320.        Function GetHandle:HDC; override;
  321.        Function GetMonochrome:Boolean; override;
  322.        Function GetSupports3DText:Boolean; override;
  323.        Function GetSupportsFullRotation:Boolean; override;
  324.        Function GetTextAlign:TCanvasTextAlign; override;
  325.        Function GetUseBuffer:Boolean; override;
  326.  
  327.        Procedure SetBackColor(Color:TColor); override;
  328.        Procedure SetBackMode(Mode:TCanvasBackMode); override;
  329.        Procedure SetMonochrome(Value:Boolean); override;
  330.        procedure SetPixel(X, Y: Integer; Value: TColor); override;
  331.        procedure SetTextAlign(Align:TCanvasTextAlign); override;
  332.        Procedure SetUseBuffer(Value:Boolean); override;
  333.  
  334.        { 3d private }
  335.        Procedure Calc3DTPoint(Var P:TPoint; z:Integer);
  336.        Function Calc3DTPoint3D(Const P:TPoint3D):TPoint;
  337.        Procedure Calc3DPoint(Var P:TPoint; x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  338.  
  339.        { 3d }
  340.        procedure SetPixel3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; Value: TColor); override;
  341.        Procedure Calc3DPos(var x,y:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; z:Integer);
  342.      public
  343.        { almost public... }
  344.        Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); override;
  345.        Function Calculate3DPosition(x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}):TPoint; override;
  346.  
  347.        { public }
  348.        Constructor Create;
  349.        Destructor Destroy; override;
  350.  
  351.        Function InitWindow( DestCanvas:TCanvas;
  352.                             A3DOptions:TView3DOptions;
  353.                             ABackColor:TColor;
  354.                             Is3D:Boolean;
  355.                             Const UserRect:TRect):TRect; override;
  356.        Function ReDrawBitmap:Boolean; override;
  357.        Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;
  358.  
  359.        procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
  360.        procedure Draw(X, Y: Integer; Graphic: TGraphic); override;
  361.        procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
  362.        procedure EraseBackground(const Rect: TRect); override;
  363.        procedure FillRect(const Rect: TRect); override;
  364.        procedure Frame3D( Rect: TRect; TopColor,BottomColor: TColor;
  365.                           Width: Integer); override;
  366.        procedure LineTo(X,Y:Integer); override;
  367.        procedure MoveTo(X,Y:Integer); override;
  368.        procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
  369.        procedure Rectangle(X0,Y0,X1,Y1:Integer); override;
  370.        procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
  371.        procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); override;
  372.        Procedure TextOut(X,Y:Integer; const Text:String); override;
  373.  
  374.        { 2d extra }
  375.        procedure ClipRectangle(Const Rect:TRect); override;
  376.        procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); override;
  377.        Procedure DoRectangle(Const Rect:TRect); override;
  378.        Procedure DoHorizLine(X0,X1,Y:Integer); override;
  379.        Procedure DoVertLine(X,Y0,Y1:Integer); override;
  380.        Procedure GradientFill( Const Rect:TRect;
  381.                                StartColor,EndColor:TColor;
  382.                                Direction:TGradientDirection); override;
  383.        Procedure Invalidate; override;
  384.        Procedure Line(X0,Y0,X1,Y1:Integer); override;
  385.        Procedure Polygon(const Points: array of TPoint); override;
  386.        procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Integer); override;
  387.        procedure RotateLabel3D( x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF};
  388.                                 Const St:String; RotDegree:Integer); override;
  389.        procedure UnClipRectangle; override;
  390.  
  391.        property XCenter:Longint read FXCenter write FXCenter;
  392.        property YCenter:Longint read FYCenter write FYCenter;
  393.  
  394.        { 3d }
  395.        Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); override;
  396.  
  397.        Procedure Arrow( Filled:Boolean;
  398.                         Const FromPoint,ToPoint:TPoint;
  399.                         ArrowWidth,ArrowHeight,Z:Integer); override;
  400.        Procedure Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean); override;
  401.        procedure Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer; Dark3D:Boolean); override;
  402.        procedure EllipseWithZ(X1, Y1, X2, Y2, Z: {$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  403.        Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); override;
  404.        Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); override;
  405.        procedure FrontPlaneBegin; override;
  406.        procedure FrontPlaneEnd; override;
  407.        Procedure HorizLine3D(Left,Right,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  408.        procedure LineTo3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  409.        Procedure LineWithZ(X0,Y0,X1,Y1,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  410.        procedure MoveTo3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  411.        procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
  412.                         Const StartAngle,EndAngle:Double;
  413.                         DarkSides,DrawSides:Boolean); override;
  414.        procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); override;
  415.        procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); override;
  416.        procedure PlaneFour3D(Points:TFourPoints; Z0,Z1:Integer); override;
  417.        procedure Pyramid(Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer; DarkSides:Boolean); override;
  418.        Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); override;
  419.        Procedure TextOut3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; const Text:String); override;
  420.        procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); override;
  421.        Procedure VertLine3D(X,Top,Bottom,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  422.        Procedure ZLine3D(X,Y,Z0,Z1:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}); override;
  423.  
  424.        property Bounds:TRect read FBounds;
  425.      end;
  426.  
  427. Function ApplyDark(Color:TColor; HowMuch:Byte):TColor;
  428. Function ApplyBright(Color:TColor; HowMuch:Byte):TColor;
  429.  
  430. Function Point3D(x,y,z:Integer):TPoint3D;
  431.  
  432. procedure SinCos(Const Angle:Extended; var ResultSin, ResultCos: Extended);
  433. function ArcTan2(Y, X: Extended): Extended;
  434.  
  435. Procedure SwapLongint(Var a,b:Longint);  { exchanges a and b }
  436. Procedure SwapDouble(Var a,b:Double);    { exchanges a and b }
  437. Procedure SwapInteger(Var a,b:Integer);  { exchanges a and b }
  438.  
  439. Function MaxDouble(Const a,b:Double):Double; { returns max (a or b) }
  440. Function MinDouble(Const a,b:Double):Double; { returns min (a or b) }
  441.  
  442. Function MaxLong(a,b:Longint):Longint; { returns max (a or b) }
  443. Function MinLong(a,b:Longint):Longint; { returns min (a or b) }
  444.  
  445. Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Longint);
  446. Procedure RectCenter(Const R:TRect; Var XCenter,YCenter:Longint);
  447. Procedure ClipCanvas(ACanvas:TCanvas; Const Rect:TRect);
  448. Procedure UnClipCanvas(ACanvas:TCanvas);
  449.  
  450. Const TeeCharForHeight     = 'W';  { <-- this is used to calculate Text Height }
  451.       DarkerColorQuantity  : Byte=128; { <-- for dark 3D sides }
  452.       DarkColorQuantity    : Byte=64;
  453.       TeeGradientPrecision : Integer = 2;   { how many pixels precision, ( 1=best) }
  454.  
  455. {$IFDEF TEETRIAL}
  456. Procedure TeeTrial(ComponentState:TComponentState);
  457. Type TTeeTrialShowAbout=Procedure(ShowOrderForm:Boolean);
  458. Var TeeTrialShowAboutBox:TTeeTrialShowAbout{$IFNDEF D1}=nil{$ENDIF};
  459. {$ENDIF}
  460.  
  461. {$IFDEF TEEGRAPHLIST}
  462. Procedure GraphListPlay(ACanvas:TCanvas);
  463. {$ENDIF}
  464.  
  465. implementation
  466.  
  467. {$IFDEF TEETRIAL}
  468. Uses TeeAbout;
  469. {$ENDIF}
  470.  
  471. {$IFDEF MONITOR_BUFFERREDRAWS}
  472. Const RedrawCountBuffer:Integer=0;
  473. {$ENDIF}
  474.  
  475. {$IFDEF TEETRIAL}
  476. Const TeeTreeMargin:Boolean=True;
  477. {$ENDIF}
  478.  
  479. type PPoints = ^TPoints;
  480.      TPoints = array[0..0] of TPoint;
  481.  
  482. {$IFDEF TEEPERF}
  483. var F:TextFile;
  484.     StartTime:Longint;
  485.  
  486. Procedure Log(Const S:String);
  487. var t:Integer;
  488. begin
  489.   t:=TimeGetTime;
  490.   WriteLn(f,IntToStr(t-StartTime)+#9+S);
  491.   StartTime:=t;
  492. end;
  493. {$ENDIF}
  494.  
  495. {$IFDEF TEEGRAPHLIST}
  496. Var GraphList:TList;
  497.  
  498. const TGL_SETBKMODE=0;
  499.       TGL_SETBKCOLOR=1;
  500.       TGL_TEXTOUT=2;
  501.       TGL_Rectangle=3;
  502.       TGL_RoundRectangle=4;
  503.       TGL_SetTextAlign=5;
  504.       TGL_MoveTo=6;
  505.       TGL_LineTo=7;
  506.       TGL_Poly=8;
  507.  
  508. type TGraphListItem=class
  509.        Id:Integer;
  510.        Value:Integer;
  511.      end;
  512.  
  513.      TGraphListTextOut=class(TGraphListItem)
  514.        x,y:Integer;
  515.        Text:String;
  516.      end;
  517.  
  518.      TGraphListRect=class(TGraphListItem)
  519.        Rect:TRect;
  520.      end;
  521.  
  522.      TGraphListRoundRect=class(TGraphListRect)
  523.        X3,Y3:Integer;
  524.      end;
  525.  
  526.      TGraphListMoveTo=class(TGraphListItem)
  527.        X,Y:Integer;
  528.      end;
  529.  
  530.      TGraphListLineTo=class(TGraphListMoveTo)
  531.      end;
  532.  
  533.      TGraphListPoly=class(TGraphListItem)
  534.        Num:Integer;
  535.        Points:PPoints;
  536.      end;
  537.  
  538. Procedure GraphListInit;
  539. begin
  540.   if GraphList=nil then GraphList:=TList.Create;
  541.   GraphList.Clear;
  542. end;
  543.  
  544. Procedure GraphListDone;
  545. var t:Integer;
  546. begin
  547.   for t:=0 to GraphList.Count-1 do
  548.       TGraphListItem(GraphList[t]).Free;
  549.   GraphList.Free;
  550. end;
  551.  
  552. Procedure GraphListAdd(Value:Pointer);
  553. begin
  554.   GraphList.Add(Value);
  555. end;
  556.  
  557. Procedure GraphListAddInteger(ID:Integer; Value:Integer);
  558. Var R:TGraphListItem;
  559. begin
  560.   R:=TGraphListItem.Create;
  561.   R.Id:=Id;
  562.   R.Value:=Value;
  563.   GraphList.Add(R);
  564. end;
  565.  
  566. Procedure GraphListAddRect(Const Rect:TRect);
  567. Var R:TGraphListRect;
  568. begin
  569.   R:=TGraphListRect.Create;
  570.   R.Id:=TGL_Rectangle;
  571.   R.Rect:=Rect;
  572.   GraphListAdd(R);
  573. end;
  574.  
  575. Procedure GraphListAddPoly(P:PPoints; N:Integer);
  576. Var R:TGraphListPoly;
  577. begin
  578.   R:=TGraphListPoly.Create;
  579.   R.Id:=TGL_Poly;
  580.   R.Num:=N;
  581.   R.Points:=P;
  582.   GraphListAdd(R);
  583. end;
  584.  
  585. Procedure GraphListAddTextOut(x,y:Integer; Const Text:String);
  586. Var R:TGraphListTextOut;
  587. begin
  588.   R:=TGraphListTextOut.Create;
  589.   R.Id:=TGL_TEXTOUT;
  590.   R.X:=X;
  591.   R.Y:=Y;
  592.   R.Text:=Text;
  593.   GraphListAdd(R);
  594. end;
  595.  
  596. Procedure GraphListAddMoveTo(x,y:Integer);
  597. Var R:TGraphListMoveTo;
  598. begin
  599.   R:=TGraphListMoveTo.Create;
  600.   R.Id:=TGL_MoveTo;
  601.   R.X:=X;
  602.   R.Y:=Y;
  603.   GraphListAdd(R);
  604. end;
  605.  
  606. Procedure GraphListAddLineTo(x,y:Integer);
  607. Var R:TGraphListLineTo;
  608. begin
  609.   R:=TGraphListLineTo.Create;
  610.   R.Id:=TGL_LineTo;
  611.   R.X:=X;
  612.   R.Y:=Y;
  613.   GraphListAdd(R);
  614. end;
  615.  
  616. Procedure GraphListPlay(ACanvas:TCanvas);
  617. var dc:HDC;
  618.     t:Integer;
  619. begin
  620.   DC:=ACanvas.Handle;
  621.   for t:=0 to GraphList.Count-1 do
  622.   With TGraphListItem(GraphList[t]) do
  623.   Case Id of
  624.       TGL_SETBKMODE  : SetBkMode(DC,Value);
  625.       TGL_SETBKCOLOR : SetBkColor(DC,Value);
  626.       TGL_TEXTOUT    :
  627.       With TGraphListTextOut(GraphList[t]) do
  628.            Windows.TextOut(dc,x,y,@Text[1],Length(Text));
  629.  
  630.       TGL_Rectangle:
  631.          With TGraphListRect(GraphList[t]).Rect do
  632.               Windows.Rectangle(dc,Left,Top,Right,Bottom);
  633.  
  634.       TGL_RoundRectangle :
  635.          With TGraphListRoundRect(GraphList[t]) do
  636.          With Rect do Windows.RoundRect(dc,Left,Top,Right,Bottom,x3,y3);
  637.       TGL_SetTextAlign : SetTextAlign(DC,Value);
  638.       TGL_MoveTo:
  639.          With TGraphListMoveTo(GraphList[t]) do
  640.               Windows.MoveToEx(dc, x,y,nil);
  641.       TGL_LineTo:
  642.          With TGraphListLineTo(GraphList[t]) do
  643.               Windows.LineTo(dc, x,y);
  644.       TGL_Poly:
  645.          With TGraphListPoly(GraphList[t]) do
  646.               Windows.Polygon(dc,Points,Num);
  647.  
  648.   end;
  649. end;
  650. {$ENDIF}
  651.  
  652. {$IFDEF D1}
  653. procedure SinCos(Const Angle:Extended; var ResultSin, ResultCos: Extended);
  654. begin
  655.   ResultSin:=Sin(Angle);
  656.   ResultCos:=Cos(Angle);
  657. end;
  658. {$ELSE}
  659. procedure SinCos(Const Angle: Extended; var ResultSin, ResultCos: Extended);
  660. asm
  661.   FLD     Angle
  662.   FSINCOS
  663.   FSTP    tbyte ptr [edx]    { Cos }
  664.   FSTP    tbyte ptr [eax]    { Sin }
  665.   FWAIT
  666. end;
  667. {$ENDIF}
  668.  
  669. {$IFDEF D1}
  670. function ArcTan2(Y, X: Extended): Extended;
  671. Const HalfPi=Pi*0.5;
  672. begin
  673.   if x=0 then
  674.   begin
  675.      if y<0 then result:=-HalfPi
  676.             else result:=HalfPi;
  677.   end
  678.   else
  679.   begin
  680.     result:=ArcTan(y/x);
  681.     if x<0 then
  682.        if y<0 then result:=result-pi
  683.               else result:=result+pi;
  684.   end;
  685. end;
  686. {$ELSE}
  687. function ArcTan2(Y, X: Extended): Extended;
  688. asm
  689.   FLD     Y
  690.   FLD     X
  691.   FPATAN
  692.   FWAIT
  693. end;
  694. {$ENDIF}
  695.  
  696. Function Point3D(x,y,z:Integer):TPoint3D;
  697. begin
  698.   result.x:=x;
  699.   result.y:=y;
  700.   result.z:=z;
  701. end;
  702.  
  703. Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Longint);
  704. begin
  705.   With R do
  706.   begin
  707.     RectWidth :=Right-Left;
  708.     RectHeight:=Bottom-Top;
  709.   end;
  710. end;
  711.  
  712. Procedure RectCenter(Const R:TRect; Var XCenter,YCenter:Longint);
  713. begin
  714.   With R do
  715.   begin
  716.     XCenter:=(Left+Right) div 2;
  717.     YCenter:=(Top+Bottom) div 2;
  718.   end;
  719. end;
  720.  
  721. { TChartPen = TPen+Visible property }
  722. Constructor TChartPen.Create(OnChangeEvent:TNotifyEvent);
  723. begin
  724.   inherited Create;
  725.   FSmallDots:=False;
  726.   FVisible:=True;
  727.   OnChange:=OnChangeEvent;
  728. end;
  729.  
  730. Procedure TChartPen.Assign(Source:TPersistent);
  731. begin
  732.   if Source is TChartPen then
  733.   begin
  734.     FVisible:=TChartPen(Source).FVisible;
  735.     FSmallDots:=TChartPen(Source).FSmallDots;
  736.   end;
  737.   inherited Assign(Source);
  738. end;
  739.  
  740. Procedure TChartPen.SetVisible(Value:Boolean);
  741. Begin
  742.   if FVisible<>Value then
  743.   begin
  744.     FVisible:=Value;
  745.     Changed;
  746.   end;
  747. end;
  748.  
  749. Procedure TChartPen.SetSmallDots(Value:Boolean);
  750. begin
  751.   if FSmallDots<>Value then
  752.   begin
  753.     FSmallDots:=Value;
  754.     Changed;
  755.   end;
  756. end;
  757.  
  758. { TChartHiddenPen }
  759. Constructor TChartHiddenPen.Create(OnChangeEvent:TNotifyEvent);
  760. Begin
  761.   inherited Create(OnChangeEvent);
  762.   Visible:=False;
  763. end;
  764.  
  765. { TDottedGrayPen }
  766. Constructor TDottedGrayPen.Create(OnChangeEvent:TNotifyEvent);
  767. Begin
  768.   inherited Create(OnChangeEvent);
  769.   Color:=clGray;
  770.   Style:=psDot;
  771. end;
  772.  
  773. { TDarkGrayPen }
  774. Constructor TDarkGrayPen.Create(OnChangeEvent:TNotifyEvent);
  775. Begin
  776.   inherited Create(OnChangeEvent);
  777.   Color:=clDkGray;
  778. end;
  779.  
  780. { TChartAxisPen }
  781. Constructor TChartAxisPen.Create(OnChangeEvent:TNotifyEvent);
  782. Begin
  783.   inherited Create(OnChangeEvent);
  784.   Width:=2;
  785. end;
  786.  
  787. { TChartArrowPen }
  788. Constructor TChartArrowPen.Create(OnChangeEvent:TNotifyEvent);
  789. Begin
  790.   inherited Create(OnChangeEvent);
  791.   Color:=clWhite;
  792. end;
  793.  
  794. { TView3DOptions }
  795. Constructor TView3DOptions.Create(AParent:TWinControl);
  796. begin
  797.   inherited Create;
  798.   FParent      :=AParent;
  799.   FOrthogonal  :=True;
  800.   FZoom        :=100; { % }
  801.   FZoomText    :=True;
  802.   FRotation    :=345;
  803.   FElevation   :=345;
  804.   FPerspective :=15; { % }
  805. end;
  806.  
  807. Procedure TView3DOptions.Repaint;
  808. begin
  809.   FParent.Invalidate;
  810. end;
  811.  
  812. Procedure TView3DOptions.SetIntegerProperty(Var Variable:Integer; Value:Integer);
  813. begin
  814.   if Variable<>Value then
  815.   begin
  816.     Variable:=Value;
  817.     Repaint;
  818.   end;
  819. end;
  820.  
  821. Procedure TView3DOptions.SetBooleanProperty(Var Variable:Boolean; Value:Boolean);
  822. begin
  823.   if Variable<>Value then
  824.   begin
  825.     Variable:=Value;
  826.     Repaint;
  827.   end;
  828. end;
  829.  
  830. Procedure TView3DOptions.SetElevation(Value:Integer);
  831. begin
  832.   SetIntegerProperty(FElevation,Value);
  833. end;
  834.  
  835. Procedure TView3DOptions.SetPerspective(Value:Integer);
  836. begin
  837.   SetIntegerProperty(FPerspective,Value);
  838. end;
  839.  
  840. Procedure TView3DOptions.SetRotation(Value:Integer);
  841. begin
  842.   SetIntegerProperty(FRotation,Value);
  843. end;
  844.  
  845. Procedure TView3DOptions.SetTilt(Value:Integer);
  846. begin
  847.   SetIntegerProperty(FTilt,Value);
  848. end;
  849.  
  850. Procedure TView3DOptions.SetHorizOffset(Value:Integer);
  851. begin
  852.   if FHorizOffset<>Value then
  853.   begin
  854.     FHorizOffset:=Value;
  855.     Repaint;
  856.     if Assigned(FOnScrolled) then FOnScrolled(True);
  857.   end;
  858. end;
  859.  
  860. Procedure TView3DOptions.SetVertOffset(Value:Integer);
  861. begin
  862.   if FVertOffset<>Value then
  863.   begin
  864.     FVertOffset:=Value;
  865.     Repaint;
  866.     if Assigned(FOnScrolled) then FOnScrolled(False);
  867.   end;
  868. end;
  869.  
  870. Procedure TView3DOptions.SetOrthogonal(Value:Boolean);
  871. begin
  872.   SetBooleanProperty(FOrthogonal,Value);
  873. end;
  874.  
  875. Procedure TView3DOptions.SetZoom(Value:Integer);
  876. begin
  877.   if FZoom<>Value then
  878.   begin
  879.     if Assigned(FOnChangedZoom) then FOnChangedZoom(Value);
  880.     FZoom:=Value;
  881.     Repaint;
  882.   end;
  883. end;
  884.  
  885. Procedure TView3DOptions.SetZoomText(Value:Boolean);
  886. begin
  887.   SetBooleanProperty(FZoomText,Value);
  888. end;
  889.  
  890. Procedure TView3DOptions.Assign(Source:TPersistent);
  891. begin
  892.   if Source is TView3DOptions then
  893.   With TView3DOptions(Source) do
  894.   begin
  895.     Self.FElevation   :=FElevation;
  896.     Self.FHorizOffset :=FHorizOffset;
  897.     Self.FOrthogonal  :=FOrthogonal;
  898.     Self.FPerspective :=FPerspective;
  899.     Self.FRotation    :=FRotation;
  900.     Self.FTilt        :=FTilt;
  901.     Self.FVertOffset  :=FVertOffset;
  902.     Self.FZoom        :=FZoom;
  903.     Self.FZoomText    :=FZoomText;
  904.   end;
  905. end;
  906.  
  907. { TTeeCanvas }
  908. Procedure TTeeCanvas.SetCanvas(ACanvas:TCanvas);
  909. begin
  910.   FCanvas := ACanvas;
  911.   FPen    := FCanvas.Pen;
  912.   FFont   := FCanvas.Font;
  913.   FBrush  := FCanvas.Brush;
  914. end;
  915.  
  916. Procedure TTeeCanvas.ResetState;
  917. begin
  918.   With FPen do
  919.   begin
  920.     Color:=clBlack;
  921.     Width:=1;
  922.     Style:=psSolid;
  923.   end;
  924.   With FBrush do
  925.   begin
  926.     Color:=clWhite;
  927.     Style:=bsSolid;
  928.   end;
  929.   With FFont do
  930.   begin
  931.     Color:=clBlack;
  932.     Size:=10;
  933.   end;
  934.   BackColor:=clWhite;
  935.   BackMode:=cbmTransparent;
  936. end;
  937.  
  938. procedure TTeeCanvas.AssignVisiblePen(APen:TChartPen);
  939. Var LBrush:TLogBrush;
  940. begin
  941.   if APen.Visible then
  942.   begin
  943.     {$IFNDEF D1}    { only valid in Windows-NT ... }
  944.     if APen.SmallDots and (APen.Width=1) and
  945.        (Win32Platform=VER_PLATFORM_WIN32_NT) then
  946.     begin
  947.       LBrush.lbStyle:=bs_Solid;
  948.       LBrush.lbColor:=ColorToRGB(APen.Color);
  949.       FPen.Handle:=ExtCreatePen( PS_COSMETIC or PS_ALTERNATE,
  950.                                  1,LBrush,0,nil);
  951.     end
  952.     else
  953.     {$ENDIF}
  954.       FPen.Assign(APen);
  955.   end
  956.   else
  957.     FPen.Style:=psClear;
  958. end;
  959.  
  960. Function TTeeCanvas.TextWidth(Const St:String):Integer;
  961. var Extent:TSize;
  962.     {$IFDEF D1}
  963.     tmpFont,tmpDC:THandle;
  964.     {$ENDIF}
  965. begin
  966. {$IFDEF D1}
  967.   if Metafiling then
  968.   Begin
  969.     tmpDC  :=CreateCompatibleDC(0);
  970.     tmpFont:=SelectObject(tmpDC, FFont.Handle);
  971.     if GetTextExtentPoint(tmpDC, @St[1], Length(St), Extent) then
  972.        result := Extent.cX + 1
  973.     else
  974.        result := 0;
  975.     SelectObject(tmpDC,tmpFont);
  976.     DeleteDC(tmpDC);
  977.   end
  978.   else
  979. {$ENDIF}
  980.   begin
  981.     ReferenceCanvas.Font.Assign(FFont);
  982.     if GetTextExtentPoint( ReferenceCanvas.Handle,
  983.                            {$IFNDEF D1}
  984.                            PChar(St)
  985.                            {$ELSE}
  986.                            @St[1]
  987.                            {$ENDIF}, Length(St), Extent) then
  988.        result:=Extent.cX
  989.     else
  990.        result:=0;
  991.   end;
  992. end;
  993.  
  994. Function TTeeCanvas.TextHeight(Const St:String):Integer;
  995. var Extent:TSize;
  996.     {$IFDEF D1}
  997.     tmpDC,tmpFont : THandle;
  998.     {$ENDIF}
  999. Begin
  1000. {$IFDEF D1}
  1001.   if Metafiling then
  1002.   Begin
  1003.     tmpDC  :=CreateCompatibleDC(0);
  1004.     tmpFont:=SelectObject(tmpDC, FFont.Handle);
  1005.     if GetTextExtentPoint(tmpDC, @St[1], Length(St), Extent) then
  1006.        result := Extent.cY
  1007.     else
  1008.        result := 0;
  1009.     SelectObject(tmpDC,tmpFont);
  1010.     DeleteDC(tmpDC);
  1011.   end
  1012.   else
  1013. {$ENDIF}
  1014.   begin
  1015.     ReferenceCanvas.Font.Assign(FFont);
  1016.     if GetTextExtentPoint( ReferenceCanvas.Handle,
  1017.                            {$IFNDEF D1}
  1018.                            PChar(St)
  1019.                            {$ELSE}
  1020.                            @St[1]
  1021.                            {$ENDIF}, Length(St), Extent) then
  1022.        result:=Extent.cY
  1023.     else
  1024.        result:=0;
  1025.   end;
  1026. end;
  1027.  
  1028. Function TTeeCanvas.FontHeight:Integer;
  1029. begin
  1030.   result:=TextHeight(TeeCharForHeight);
  1031. end;
  1032.  
  1033. { TCanvas3D }
  1034. Procedure TCanvas3D.Assign(Source:TCanvas3D);
  1035. begin
  1036.   Monochrome:=Source.Monochrome;
  1037. end;
  1038.  
  1039. { TTeeCanvas3D }
  1040. Constructor TTeeCanvas3D.Create;
  1041. begin
  1042.   inherited Create;
  1043.   IZoomText:=True;
  1044.   FMetafiling:=False;
  1045.   FCanvas:=nil;
  1046.   F3DOptions:=nil;
  1047.   FBitmap:=nil;
  1048.   FIs3D:=False;
  1049.   FBufferedDisplay:=True;
  1050.   FDirty:=True;
  1051.   {$IFDEF TEEPERF}
  1052.   AssignFile(f,'c:\log.txt');
  1053.   Rewrite(f);
  1054.   StartTime:=TimeGetTime;
  1055.   Log('create');
  1056.   {$ENDIF}
  1057. end;
  1058.  
  1059. Destructor TTeeCanvas3D.Destroy;
  1060. begin
  1061.   if Assigned(FBitmap) then
  1062.   begin
  1063.     FBitmap.Free;
  1064.     FBitmap:=nil;
  1065.   end;
  1066.   {$IFDEF TEEPERF}
  1067.   CloseFile(f);
  1068.   {$ENDIF}
  1069.   {$IFDEF TEEGRAPHLIST}
  1070.   GraphListDone;
  1071.   {$ENDIF}
  1072.   inherited Destroy;
  1073. end;
  1074.  
  1075. Function TTeeCanvas3D.GetBackMode:TCanvasBackMode;
  1076. begin
  1077.   {$IFDEF TEEPERF}
  1078.   Log('GetBackMode');
  1079.   {$ENDIF}
  1080.   result:=TCanvasBackMode(GetBkMode(FCanvas.Handle));
  1081. end;
  1082.  
  1083. Procedure TTeeCanvas3D.SetBackMode(Mode:TCanvasBackMode); { Opaque, Transparent }
  1084. begin
  1085.   {$IFDEF TEEPERF}
  1086.   Log('SetBackMode');
  1087.   {$ENDIF}
  1088.   SetBkMode(FCanvas.Handle,Ord(Mode));
  1089.   {$IFDEF TEEGRAPHLIST}
  1090.   GraphListAddInteger(TGL_SETBKMODE,Ord(Mode));;
  1091.   {$ENDIF}
  1092. end;
  1093.  
  1094. Procedure TTeeCanvas3D.SetBackColor(Color:TColor);
  1095. begin
  1096.   {$IFDEF TEEPERF}
  1097.   Log('SetBackColor');
  1098.   {$ENDIF}
  1099.   SetBkColor(FCanvas.Handle,Color);
  1100.   {$IFDEF TEEGRAPHLIST}
  1101.   GraphListAddInteger(TGL_SETBKCOLOR,Color);;
  1102.   {$ENDIF}
  1103. end;
  1104.  
  1105. function TTeeCanvas3D.GetBackColor:TColor;
  1106. begin
  1107.   {$IFDEF TEEPERF}
  1108.   Log('GetBackColor');
  1109.   {$ENDIF}
  1110.   result:=GetBkColor(FCanvas.Handle);
  1111. end;
  1112.  
  1113. Procedure TTeeCanvas3D.TextOut(X,Y:Integer; const Text:String);
  1114. begin
  1115.   {$IFDEF TEEPERF}
  1116.   Log('TextOut');
  1117.   {$ENDIF}
  1118.   FCanvas.TextOut(X,Y,Text);
  1119.   {$IFDEF TEEGRAPHLIST}
  1120.   GraphListAddTextOut(x,y,Text);
  1121.   {$ENDIF}
  1122. end;
  1123.  
  1124. procedure TTeeCanvas3D.Rectangle(X0,Y0,X1,Y1:Integer);
  1125. begin
  1126.   {$IFDEF TEEPERF}
  1127.   Log('Rectangle');
  1128.   {$ENDIF}
  1129.   FCanvas.Rectangle(X0,Y0,X1,Y1);
  1130.   {$IFDEF TEEGRAPHLIST}
  1131.   GraphListAddRect(Rect(X0,Y0,X1,Y1));
  1132.   {$ENDIF}
  1133. end;
  1134.  
  1135. procedure TTeeCanvas3D.RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer);
  1136. {$IFDEF TEEGRAPHLIST}
  1137. Var R:TGraphListRoundRect;
  1138. {$ENDIF}
  1139. begin
  1140.   {$IFDEF TEEPERF}
  1141.   Log('RoundRect');
  1142.   {$ENDIF}
  1143.   FCanvas.RoundRect(X1,Y1,X2,Y2,X3,Y3);
  1144.   {$IFDEF TEEGRAPHLIST}
  1145.   R:=TGraphListRoundRect.Create;
  1146.   R.Id:=TGL_RoundRectangle;
  1147.   R.Rect:=Rect(X1,Y1,X2,Y2);
  1148.   R.X3:=X3;
  1149.   R.Y3:=Y3;
  1150.   GraphListAdd(R);
  1151.   {$ENDIF}
  1152. end;
  1153.  
  1154. procedure TTeeCanvas3D.SetTextAlign(Align:TCanvasTextAlign);
  1155. begin
  1156.   {$IFDEF TEEPERF}
  1157.   Log('SetTextAlign');
  1158.   {$ENDIF}
  1159.   {$IFDEF D1}
  1160.   WinProcs.SetTextAlign(FCanvas.Handle,Ord(Align));
  1161.   {$ELSE}
  1162.   Windows.SetTextAlign(FCanvas.Handle,Ord(Align));
  1163.   {$ENDIF}
  1164.   {$IFDEF TEEGRAPHLIST}
  1165.   GraphListAddInteger(TGL_SetTextAlign,Ord(Align));
  1166.   {$ENDIF}
  1167. end;
  1168.  
  1169. procedure TTeeCanvas3D.MoveTo(X,Y:Integer);
  1170. begin
  1171.   {$IFDEF TEEPERF}
  1172.   Log('MoveTo');
  1173.   {$ENDIF}
  1174.   {$IFDEF D1}
  1175.   WinProcs.MoveToEx(FCanvas.Handle, X, Y, nil);
  1176.   {$ELSE}
  1177.   Windows.MoveToEx(FCanvas.Handle, X, Y, nil);
  1178.   {$ENDIF}
  1179.   {$IFDEF TEEGRAPHLIST}
  1180.   GraphListAddMoveTo(x,y);
  1181.   {$ENDIF}
  1182. end;
  1183.  
  1184. procedure TTeeCanvas3D.LineTo(X,Y:Integer);
  1185. begin
  1186.   {$IFDEF TEEPERF}
  1187.   Log('LineTo');
  1188.   {$ENDIF}
  1189.   {$IFDEF D1}
  1190.   WinProcs.LineTo(FCanvas.Handle, X, Y);
  1191.   {$ELSE}
  1192.   Windows.LineTo(FCanvas.Handle, X, Y);
  1193.   {$ENDIF}
  1194.   {$IFDEF TEEGRAPHLIST}
  1195.   GraphListAddLineTo(x,y);
  1196.   {$ENDIF}
  1197. end;
  1198.  
  1199. Procedure TTeeCanvas3D.DoRectangle(Const Rect:TRect);
  1200. begin
  1201.   {$IFDEF TEEPERF}
  1202.   Log('DoRectangle');
  1203.   {$ENDIF}
  1204.   With Rect do FCanvas.Rectangle(Left,Top,Right,Bottom);
  1205.   {$IFDEF TEEGRAPHLIST}
  1206.   GraphListAddRect(Rect);
  1207.   {$ENDIF}
  1208. end;
  1209.  
  1210. { 3D Canvas }
  1211. procedure TTeeCanvas3D.PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer);
  1212. Var Points:TFourPoints;
  1213. begin
  1214.   {$IFDEF TEEPERF}
  1215.   Log('PlaneWithZ');
  1216.   {$ENDIF}
  1217.   Calc3DTPoint(P1,Z);
  1218.   Calc3DTPoint(P2,Z);
  1219.   Calc3DTPoint(P3,Z);
  1220.   Calc3DTPoint(P4,Z);
  1221.   Points[0]:=P1;
  1222.   Points[1]:=P2;
  1223.   Points[2]:=P3;
  1224.   Points[3]:=P4;
  1225.   {$IFDEF D1}
  1226.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  1227.   {$ELSE}
  1228.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  1229.   {$ENDIF}
  1230.   {$IFDEF TEEGRAPHLIST}
  1231.   GraphListAddPoly(@Points,4);
  1232.   {$ENDIF}
  1233. end;
  1234.  
  1235. Procedure TTeeCanvas3D.Calc3DTPoint(Var P:TPoint; z:Integer);
  1236. begin
  1237.   {$IFDEF TEEPERF}
  1238.   Log('Calc3DTPoint');
  1239.   {$ENDIF}
  1240.   Calc3DPos(P.X,P.Y,Z);
  1241. end;
  1242.  
  1243. Function TTeeCanvas3D.Calc3DTPoint3D(Const P:TPoint3D):TPoint;
  1244. begin
  1245.   {$IFDEF TEEPERF}
  1246.   Log('Calc3DTPoint3D');
  1247.   {$ENDIF}
  1248.   Calc3DPoint(result,P.X,P.Y,P.Z);
  1249. end;
  1250.  
  1251. Function TTeeCanvas3D.Calculate3DPosition(x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}):TPoint;
  1252. begin
  1253.   Calc3DPos(x,y,z);
  1254.   result.x:=x;
  1255.   result.y:=y;
  1256. end;
  1257.  
  1258. Procedure TTeeCanvas3D.Calc3DPoint( Var P:TPoint;
  1259.                                     x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  1260. begin
  1261.   {$IFDEF TEEPERF}
  1262.   Log('Calc3DPoint');
  1263.   {$ENDIF}
  1264.   Calc3DPos(x,y,z);
  1265.   P.x:=x;
  1266.   P.y:=y;
  1267. end;
  1268.  
  1269. Procedure TTeeCanvas3D.Calculate2DPosition(Var x,y:Integer; z:Integer);
  1270. var x1:Integer;
  1271.     tmp:Double;
  1272. begin
  1273.   if IZoomFactor<>0 then
  1274.   begin
  1275.     tmp:=1.0/IZoomFactor;
  1276.     if FIsOrthogonal then
  1277.     begin
  1278.       x:=Round((x-FXCenterOffset)*tmp)-z+FXCenter;
  1279.       y:=Round((y-FYCenterOffset)*tmp)+z+FYCenter;
  1280.     end
  1281.     else
  1282.     if FIs3D and (tempXX<>0) and (c2c3<>0)  then
  1283.     begin
  1284.       x1:=x;
  1285.       z:=z-FZCenter;
  1286.       x:=Round((((x1-FXCenterOffset)*tmp)-(z*tempXZ)-
  1287.                  (y -FYCenter)*c2s3)   / tempXX) + FXCenter;
  1288.       y:=Round((((y -FYCenterOffset)*tmp)-(z*tempYZ)-
  1289.                  (x1-FXCenter)*tempYX) / c2c3)   + FYCenter;
  1290.     end;
  1291.   end;
  1292. end;
  1293.  
  1294. Procedure TTeeCanvas3D.Calc3DPos(Var x,y:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; z:Integer);
  1295. var x1 : Integer;
  1296.     tmp: Double;
  1297.     y1 : Integer;
  1298. begin
  1299.   {$IFDEF TEEPERF}
  1300.   Log('Calc3DPos');
  1301.   {$ENDIF}
  1302.   if FIsOrthogonal then
  1303.   begin
  1304.     x:=Round( IZoomFactor*(x-FXCenter+z) )+FXCenterOffset;
  1305.     y:=Round( IZoomFactor*(y-FYCenter-z) )+FYCenterOffset;
  1306.   end
  1307.   else
  1308.   if FIs3D then
  1309.   begin
  1310.     Dec(z,FZCenter);
  1311.     x1:=x-FXCenter;
  1312.     y1:=y-FYCenter;
  1313.     if IPerspec>0 then
  1314.        tmp:=IZoomFactor*(1-((x1*c2s1 -y1*s2 + z*c2c1)*IPerspec))
  1315.     else
  1316.        tmp:=IZoomFactor;
  1317.     x:=Round((x1*tempXX + y1*c2s3 + z*tempXZ)*tmp)+FXCenterOffset;
  1318.     y:=Round((x1*tempYX + y1*c2c3 + z*tempYZ)*tmp)+FYCenterOffset;
  1319.   end;
  1320. end;
  1321.  
  1322. Function TTeeCanvas3D.GetHandle:HDC;
  1323. begin
  1324.   {$IFDEF TEEPERF}
  1325.   Log('GetHandle');
  1326.   {$ENDIF}
  1327.   result:=FCanvas.Handle;
  1328. end;
  1329.  
  1330. {  NONANTIALIASED_QUALITY = 3;
  1331.   ANTIALIASED_QUALITY = 4;}
  1332.  
  1333. Procedure TTeeCanvas3D.TextOut3D(x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; const Text:String);
  1334. var tmp            : Integer;
  1335.     OldSize        : Integer;
  1336.     tmpSizeChanged : Boolean;
  1337.     DC             : HDC;
  1338.     LogRec         : TLogFont;
  1339.     NewFont        : HFont;
  1340.     OldFont        : HFont;
  1341. begin
  1342.   {$IFDEF TEEPERF}
  1343.   Log('TextOut3D');
  1344.   {$ENDIF}
  1345.  
  1346.   Calc3DPos(x,y,z);
  1347.   if IZoomText then
  1348.   begin
  1349.     tmpSizeChanged:=False;
  1350.     DC:=0;
  1351.     OldFont:=0;
  1352.     if IZoomFactor<>1 then
  1353.     With FFont do
  1354.     begin
  1355.       OldSize:=Size;
  1356.       tmp:=MaxLong(1,Round(IZoomFactor*OldSize));
  1357.       if OldSize<>tmp then
  1358.       begin
  1359.         DC:=FCanvas.Handle;
  1360.         GetObject(FFont.Handle, SizeOf(LogRec), @LogRec);
  1361.         LogRec.lfHeight:= -MulDiv( tmp,FFont.PixelsPerInch,72);
  1362.         NewFont:=CreateFontIndirect(LogRec);
  1363.         OldFont:=SelectObject(DC,NewFont);
  1364.         tmpSizeChanged:=True;
  1365.       end;
  1366.     end;
  1367.     FCanvas.TextOut(X,Y,Text);
  1368.     if tmpSizeChanged then DeleteObject(SelectObject(DC,OldFont));
  1369.   end
  1370.   else FCanvas.TextOut(X,Y,Text);
  1371.   {$IFDEF TEEGRAPHLIST}
  1372.   GraphListAddTextOut(x,y,Text);
  1373.   {$ENDIF}
  1374. end;
  1375.  
  1376. procedure TTeeCanvas3D.MoveTo3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  1377. begin
  1378.   {$IFDEF TEEPERF}
  1379.   Log('MoveTo3D');
  1380.   {$ENDIF}
  1381.   Calc3DPos(x,y,z);
  1382.   {$IFDEF D1}
  1383.   WinProcs.MoveToEx(FCanvas.Handle, X, Y, nil);
  1384.   {$ELSE}
  1385.   Windows.MoveToEx(FCanvas.Handle, X, Y, nil);
  1386.   {$ENDIF}
  1387.   {$IFDEF TEEGRAPHLIST}
  1388.   GraphListAddMoveTo(x,y);
  1389.   {$ENDIF}
  1390. end;
  1391.  
  1392. procedure TTeeCanvas3D.LineTo3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  1393. begin
  1394.   {$IFDEF TEEPERF}
  1395.   Log('LineTo3D');
  1396.   {$ENDIF}
  1397.   Calc3DPos(x,y,z);
  1398.   {$IFDEF D1}
  1399.   WinProcs.LineTo(FCanvas.Handle, X, Y);
  1400.   {$ELSE}
  1401.   Windows.LineTo(FCanvas.Handle, X, Y);
  1402.   {$ENDIF}
  1403.   FCanvas.LineTo(X,Y);
  1404.   {$IFDEF TEEGRAPHLIST}
  1405.   GraphListAddLineTo(x,y);
  1406.   {$ENDIF}
  1407. end;
  1408.  
  1409. Procedure TTeeCanvas3D.RectangleWithZ(Const Rect:TRect; Z:Integer);
  1410. var Points : TFourPoints;
  1411. begin
  1412.   {$IFDEF TEEPERF}
  1413.   Log('RectangleWithZ');
  1414.   {$ENDIF}
  1415.   With Rect do
  1416.   begin
  1417.     Calc3DPoint(Points[0],Left,Top,Z);
  1418.     Calc3DPoint(Points[1],Right,Top,Z);
  1419.     Calc3DPoint(Points[2],Right,Bottom,Z);
  1420.     Calc3DPoint(Points[3],Left,Bottom,Z);
  1421.   end;
  1422.   {$IFDEF D1}
  1423.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  1424.   {$ELSE}
  1425.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  1426.   {$ENDIF}
  1427.   {$IFDEF TEEGRAPHLIST}
  1428.   GraphListAddPoly(@Points,4);
  1429.   {$ENDIF}
  1430. end;
  1431.  
  1432. Procedure TTeeCanvas3D.DoHorizLine(X0,X1,Y:Integer);
  1433. var DC : HDC;
  1434. begin
  1435.   {$IFDEF TEEPERF}
  1436.   Log('DoHorizLine');
  1437.   {$ENDIF}
  1438.   DC:=FCanvas.Handle;
  1439.   {$IFDEF D1}
  1440.   WinProcs.MoveToEx(DC,X0,Y,nil);
  1441.   WinProcs.LineTo(DC,X1,Y);
  1442.   {$ELSE}
  1443.   Windows.MoveToEx(DC,X0,Y,nil);
  1444.   Windows.LineTo(DC,X1,Y);
  1445.   {$ENDIF}
  1446.   {$IFDEF TEEGRAPHLIST}
  1447.   GraphListAddMoveTo(x0,y);
  1448.   GraphListAddLineTo(x1,y);
  1449.   {$ENDIF}
  1450. end;
  1451.  
  1452. Procedure TTeeCanvas3D.DoVertLine(X,Y0,Y1:Integer);
  1453. var DC : HDC;
  1454. begin
  1455.   {$IFDEF TEEPERF}
  1456.   Log('DoVertLine');
  1457.   {$ENDIF}
  1458.   DC:=FCanvas.Handle;
  1459.   MoveToEx(DC,X,Y0,nil);
  1460.   {$IFDEF D1}
  1461.   WinProcs.LineTo(DC,X,Y1);
  1462.   {$ELSE}
  1463.   Windows.LineTo(DC,X,Y1);
  1464.   {$ENDIF}
  1465.   {$IFDEF TEEGRAPHLIST}
  1466.   GraphListAddMoveTo(x,y0);
  1467.   GraphListAddLineTo(x,y1);
  1468.   {$ENDIF}
  1469. end;
  1470.  
  1471. Procedure ClipCanvas(ACanvas:TCanvas; Const Rect:TRect);
  1472. Var P      : Array[0..1] of TPoint;
  1473.     Region : HRgn;
  1474.     DC     : HDC;
  1475. begin
  1476.   with Rect do
  1477.   begin
  1478.     p[0]:=TopLeft;
  1479.     p[1]:=BottomRight;
  1480.   end;
  1481.   DC:=ACanvas.Handle;
  1482.   LPToDP(DC,P,2);
  1483.   Region:=CreateRectRgn(P[0].X,P[0].Y,P[1].X,P[1].Y);
  1484.   SelectClipRgn(DC,Region);
  1485.   DeleteObject(Region);
  1486. end;
  1487.  
  1488. procedure TTeeCanvas3D.ClipRectangle(Const Rect:TRect);
  1489. begin
  1490.   {$IFDEF TEEPERF}
  1491.   Log('ClipRectangle');
  1492.   {$ENDIF}
  1493.   ClipCanvas(FCanvas,Rect);
  1494. end;
  1495.  
  1496. procedure TTeeCanvas3D.ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer);
  1497. Var P      : Array[0..5] of TPoint;
  1498.     Region : HRgn;
  1499.     DC     : HDC;
  1500.     tmpR   : TRect;
  1501.     pa     : TPoint;
  1502.     pb     : TPoint;
  1503. begin
  1504.   {$IFDEF TEEPERF}
  1505.   Log('ClipCube');
  1506.   {$ENDIF}
  1507.   if FIs3D then
  1508.   With Rect do
  1509.   begin
  1510.     Calc3DPoint(p[0],Left,Bottom,MinZ);
  1511.     Calc3DPoint(p[1],Left,Top,MinZ);
  1512.  
  1513.     Calc3DPoint(pa,Left,Top,MaxZ);
  1514.     Calc3DPoint(pb,Right,Top,MinZ);
  1515.  
  1516.     if pb.Y<pa.Y then p[2]:=pb else p[2]:=pa;
  1517.  
  1518.     Calc3DPoint(p[3],Right,Top,MaxZ);
  1519.  
  1520.     Calc3DPoint(pa,Right,Bottom,MaxZ);
  1521.     Calc3DPoint(pb,Right,Top,MinZ);
  1522.     if pb.x>pa.x then p[4]:=pb else p[4]:=pa;
  1523.  
  1524.     Calc3DPoint(p[5],Right,Bottom,MinZ);
  1525.     DC:=FCanvas.Handle;
  1526.     LPToDP(DC,P,6);
  1527.     Region:=CreatePolygonRgn(P,6,ALTERNATE);
  1528.     SelectClipRgn(DC,Region);
  1529.     DeleteObject(Region);
  1530.   end
  1531.   else
  1532.   begin
  1533.     tmpR:=Rect;
  1534.     Inc(tmpR.Left);
  1535.     Inc(tmpR.Top);
  1536.     Dec(tmpR.Bottom);
  1537.     ClipRectangle(tmpR);
  1538.   end;
  1539. end;
  1540.  
  1541. Procedure UnClipCanvas(ACanvas:TCanvas);
  1542. {$IFDEF D1}
  1543. Var Region : HRgn;
  1544.     DC     : HDC;
  1545. {$ENDIF}
  1546. begin
  1547.   {$IFDEF D1}
  1548.   DC:=ACanvas.Handle;
  1549.   Region:=CreateRectRgn( 0,0,
  1550.                          GetDeviceCaps(DC,HORZRES),
  1551.                          GetDeviceCaps(DC,VERTRES) );
  1552.   SelectClipRgn(DC,Region);
  1553.   DeleteObject(Region);
  1554.   {$ELSE}
  1555.   SelectClipRgn(ACanvas.Handle,0);
  1556.   {$ENDIF}
  1557. end;
  1558.  
  1559. procedure TTeeCanvas3D.UnClipRectangle;
  1560. begin
  1561.   {$IFDEF TEEPERF}
  1562.   Log('UnClipRectangle');
  1563.   {$ENDIF}
  1564.   UnClipCanvas(FCanvas);
  1565. end;
  1566.  
  1567. Procedure TTeeCanvas3D.Projection(MaxDepth:Integer; const Bounds,Rect:TRect);
  1568. begin
  1569.   {$IFDEF TEEPERF}
  1570.   Log('Projection');
  1571.   {$ENDIF}
  1572.   RectCenter(Rect,FXCenter,FYCenter);
  1573.   FZCenter      :=MaxDepth div 2;
  1574.   FXCenterOffset:=FXCenter;
  1575.   FYCenterOffset:=FYCenter;
  1576.   if Assigned(F3DOptions) then
  1577.   With F3DOptions do
  1578.   begin
  1579.     Inc(FXCenterOffset,HorizOffset);
  1580.     Inc(FYCenterOffset,VertOffset);
  1581.     if Perspective>0 then IPerspec:=Perspective/35000.0;
  1582.   end;
  1583. end;
  1584.  
  1585. Function TTeeCanvas3D.InitWindow( DestCanvas:TCanvas;
  1586.                                   A3DOptions:TView3DOptions;
  1587.                                   ABackColor:TColor;
  1588.                                   Is3D:Boolean;
  1589.                                   Const UserRect:TRect):TRect;
  1590. Procedure CalcTrigValues;
  1591. Var c1:Extended;
  1592.     c2:Extended;
  1593.     c3:Extended;
  1594.     s1:Extended;
  1595.     s3:Extended;
  1596.     rx:Double;
  1597.     ry:Double;
  1598.     rz:Double;
  1599. begin
  1600.   {$IFDEF TEEPERF}
  1601.   Log('CalcTrigValues');
  1602.   {$ENDIF}
  1603.   if not FIsOrthogonal then
  1604.   begin
  1605.     if Assigned(F3DOptions) then
  1606.     With F3DOptions do
  1607.     begin
  1608.       rx:=Rotation;
  1609.       ry:=Elevation;
  1610.       rz:=Tilt;
  1611.     end
  1612.     else
  1613.     begin
  1614.       rx:=0;
  1615.       ry:=0;
  1616.       rz:=0;
  1617.     end;
  1618.  
  1619.     IPerspec:=0;
  1620.  
  1621.     SinCos(rx*TeePiStep,s1,c1);
  1622.     SinCos(ry*TeePiStep,s2,c2);
  1623.     SinCos(rz*TeePiStep,s3,c3);
  1624.  
  1625.     c2s3:=c2*s3;
  1626.     c2c3:=MaxDouble(1E-5,c2*c3);
  1627.  
  1628.     tempXX:=MaxDouble(1E-5, s1*s2*s3 + c1*c3 );
  1629.     tempYX:=( c3*s1*s2 - c1*s3 );
  1630.  
  1631.     tempXZ:=( c1*s2*s3 - c3*s1 );
  1632.     tempYZ:=( c1*c3*s2 + s1*s3 );
  1633.  
  1634.     c2s1:=c2*s1;
  1635.     c2c1:=c1*c2;
  1636.   end;
  1637. end;
  1638.  
  1639. var tmpH:Longint;
  1640.     tmpW:Longint;
  1641.     tmpCanvas:TCanvas;
  1642. begin
  1643.   {$IFDEF TEEPERF}
  1644.   Log('InitWindow');
  1645.   {$ENDIF}
  1646.   {$IFDEF TEEGRAPHLIST}
  1647.   GraphListInit;
  1648.   {$ENDIF}
  1649.   FBounds:=UserRect;
  1650.   F3DOptions:=A3DOptions;
  1651.  
  1652.   FIs3D:=Is3D;
  1653.   FIsOrthogonal:=False;
  1654.   IZoomFactor:=1;
  1655.   if FIs3D then
  1656.   begin
  1657.     if Assigned(F3DOptions) then
  1658.     begin
  1659.       FIsOrthogonal:=F3DOptions.Orthogonal;
  1660.       IZoomFactor:=0.01*F3DOptions.Zoom;
  1661.       IZoomText:=F3DOptions.ZoomText;
  1662.     end;
  1663.     CalcTrigValues;
  1664.   end;
  1665.  
  1666.   if FBufferedDisplay then
  1667.   begin
  1668.     RectSize(UserRect,tmpW,tmpH);
  1669.     if Assigned(FBitmap) and
  1670.        ((FBitmap.Width<>tmpW) or (FBitmap.Height<>tmpH)) then
  1671.     begin
  1672.       FBitmap.Free;
  1673.       FBitmap:=nil;
  1674.     end;
  1675.     if not Assigned(FBitmap) then
  1676.     begin
  1677.       FBitmap:=TBitMap.Create;
  1678.       FBitmap.Monochrome:=FMonochrome;
  1679.       FBitmap.Width :=tmpW;
  1680.       FBitmap.Height:=tmpH;
  1681.     end;
  1682.     tmpCanvas:=FBitmap.Canvas;
  1683.     tmpCanvas.OnChange:=nil;
  1684.     tmpCanvas.OnChanging:=nil;
  1685.     SetCanvas(tmpCanvas);
  1686.     result:=Rect(0,0,tmpW,tmpH);
  1687.   end
  1688.   else
  1689.   begin
  1690.     SetCanvas(DestCanvas);
  1691.     result:=UserRect;
  1692.   end;
  1693. end;
  1694.  
  1695. {$IFDEF TEEUSEDRAWDIB}
  1696. type HDRAWDIB=Longint;
  1697.  
  1698. Const vfw='msvfw32.dll';
  1699.       DDF_JUSTDRAWIT=$80;
  1700.       DDF_DONTDRAW=$10;
  1701.       DDF_HURRYUP=$800;
  1702.  
  1703. function DrawDibOpen:HDrawDib; external vfw name 'DrawDibOpen';
  1704. function DrawDibClose(hdd:HDrawDib):Bool; external vfw name 'DrawDibClose';
  1705. function DrawDibDraw(hdd:HDRAWDIB; dc:HDC; x,y,dx,dy:Integer;
  1706.                                    bpi:PBITMAPINFOHEADER;
  1707.                                    Bits:Pointer;
  1708.                                    xs,ys,dxs,dys:Integer;
  1709.                                    Flags:UINT):Bool;
  1710.                                    external vfw name 'DrawDibDraw';
  1711.  
  1712. var hdd:HDRAWDIB;
  1713. {$ENDIF}
  1714.  
  1715.  
  1716. Procedure TTeeCanvas3D.TransferBitmap(ALeft,ATop:Integer; ACanvas:TCanvas);
  1717. {$IFDEF TEEUSEDRAWDIB}
  1718. var ColorBitsSize,ColorInfoSize: DWORD;
  1719.     ColorInfo, ColorBits: Pointer;
  1720. {$ENDIF}
  1721. begin
  1722.   {$IFDEF TEEPERF}
  1723.   Log('TransferBitmap');
  1724.   {$ENDIF}
  1725. {$IFDEF MONITOR_BUFFERREDRAWS}
  1726.   Inc(RedrawCountBuffer);
  1727.   FBitmap.Canvas.TextOut(0,20,IntToStr(RedrawCountBuffer));
  1728. {$ENDIF}
  1729. {$IFDEF TEEUSEDRAWDIB}
  1730.   GetDIBSizes(FBitmap.Handle, ColorInfoSize, ColorBitsSize);
  1731.   GetMem(ColorInfo,ColorInfoSize);
  1732.   GetMem(ColorBits,ColorBitsSize);
  1733.   GetDIB(FBitmap.Handle, 0, ColorInfo^, ColorBits^);
  1734.   DrawDibDraw(hdd,ACanvas.Handle,ALeft,ATop,FBitmap.Width,
  1735.           FBitmap.Height,ColorInfo,ColorBits,0,0,FBitmap.Width,FBitmap.Height,
  1736.           0);
  1737.   FreeMem(ColorInfo,ColorInfoSize);
  1738.   FreeMem(ColorBits,ColorBitsSize);
  1739. {$ELSE}
  1740.   BitBlt( ACanvas.Handle,ALeft,ATop,
  1741.           FBitmap.Width,
  1742.           FBitmap.Height,
  1743.           FBitmap.Canvas.Handle,0,0,SRCCOPY);
  1744. {$ENDIF}
  1745. end;
  1746.  
  1747. Function TTeeCanvas3D.ReDrawBitmap:Boolean;
  1748. begin
  1749.   {$IFDEF TEEPERF}
  1750.   Log('RedrawBitmap');
  1751.   {$ENDIF}
  1752.   result:=not FDirty;
  1753.   if result then TransferBitmap(0,0,FCanvas);
  1754. end;
  1755.  
  1756. Procedure TTeeCanvas3D.ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect);
  1757. begin
  1758.   {$IFDEF TEEPERF}
  1759.   Log('ShowImage');
  1760.   {$ENDIF}
  1761.   if FBufferedDisplay then
  1762.   begin
  1763.     With UserRect do TransferBitmap(Left,Top,DestCanvas);
  1764.     FDirty:=False;
  1765.   end;
  1766.   SetCanvas(DefaultCanvas);
  1767. end;
  1768.  
  1769. procedure TTeeCanvas3D.StretchDraw(const Rect: TRect; Graphic: TGraphic);
  1770. begin
  1771.   {$IFDEF TEEPERF}
  1772.   Log('StretchDraw');
  1773.   {$ENDIF}
  1774.   FCanvas.StretchDraw(Rect,Graphic);
  1775. end;
  1776.  
  1777. procedure TTeeCanvas3D.Draw(X, Y: Integer; Graphic: TGraphic);
  1778. begin
  1779.   {$IFDEF TEEPERF}
  1780.   Log('Draw');
  1781.   {$ENDIF}
  1782.   FCanvas.Draw(X,Y,Graphic);
  1783. end;
  1784.  
  1785. Procedure TTeeCanvas3D.GradientFill( Const Rect : TRect;
  1786.                                      StartColor : TColor;
  1787.                                      EndColor   : TColor;
  1788.                                      Direction  : TGradientDirection);
  1789.  
  1790. Var Trgb     : Array[0..2] of Integer;
  1791.     Drgb     : Array[0..2] of Integer;
  1792.     tmpBrush : HBRUSH;
  1793.     DC       : HDC;
  1794.     OldColor : TColor;
  1795.  
  1796.   Procedure CalcBrushColor(Index,Range:Integer);
  1797.   var tmp:TColor;
  1798.   begin
  1799.     tmp:=RGB( Trgb[0] + MulDiv(Index,Drgb[0],Range),
  1800.                                 Trgb[1] + MulDiv(Index,Drgb[1],Range),
  1801.                                 Trgb[2] + MulDiv(Index,Drgb[2],Range));
  1802.     if tmp<>OldColor then
  1803.     begin
  1804.       if tmpBrush<>0 then DeleteObject(SelectObject(DC,tmpBrush));
  1805.       tmpBrush:=SelectObject(DC,CreateSolidBrush(tmp));
  1806.       OldColor:=tmp;
  1807.     end;
  1808.   end;
  1809.  
  1810. Var Size     : Longint;
  1811.     Steps    : Longint;
  1812.     tmpRect  : TRect;
  1813.     SizeX    : Longint;
  1814.     SizeY    : Longint;
  1815.     XCenter,
  1816.     YCenter,
  1817.     tmp1,
  1818.     tmp2,
  1819.     P0,
  1820.     P1,
  1821.     P2,
  1822.     P3       : Integer;
  1823.  
  1824.  
  1825.   Procedure CleanBrushes;
  1826.   begin
  1827.     if tmpBrush<>0 then DeleteObject(SelectObject(DC,tmpBrush));
  1828.   end;
  1829.  
  1830.   Procedure RectGradient(Horizontal:Boolean);
  1831.   var t : Integer;
  1832.   begin
  1833.     Steps:=Size;
  1834.     if Steps>256 then Steps:=256;
  1835.  
  1836.     DC:=FCanvas.Handle;
  1837.  
  1838.     With Rect do
  1839.     begin
  1840.       if Horizontal then P3:=Bottom-Top
  1841.                     else P3:=Right-Left;
  1842.       P1:=MulDiv(0,Size,Steps);
  1843.       OldColor:=-1;
  1844.       for t:=0 to Steps-1 do
  1845.       Begin
  1846.         CalcBrushColor(t,Pred(Steps));
  1847.         P2:=MulDiv(t+1,Size,Steps);
  1848.         if Horizontal then
  1849.         Begin
  1850.           P0:=Right-P1;
  1851.           PatBlt(DC,P0,Top,Right-P2-P0,P3,PATCOPY);
  1852.         end
  1853.         Else
  1854.         Begin
  1855.           P0:=Bottom-P1;
  1856.           PatBlt(DC,Left,P0,P3,Bottom-P2-P0,PATCOPY);
  1857.         end;
  1858.         P1:=P2;
  1859.       end;
  1860.     end;
  1861.   end;
  1862.  
  1863. var tmpLeft : Integer;
  1864.     tmpTop  : Integer;
  1865.     tmp3    : Integer;
  1866.     tmpDiagonal: Integer;
  1867.     FromTop : Boolean;
  1868. Begin
  1869.   {$IFDEF TEEPERF}
  1870.   Log('GradientFill');
  1871.   {$ENDIF}
  1872.   tmpRect:=Rect;
  1873.   With tmpRect do
  1874.   begin
  1875.     if Right<Left then SwapInteger(Left,Right);
  1876.     if Bottom<Top then SwapInteger(Top,Bottom);
  1877.   end;
  1878.  
  1879.   Trgb[0]:=GetRValue(StartColor);
  1880.   Trgb[1]:=GetGValue(StartColor);
  1881.   Trgb[2]:=GetBValue(StartColor);
  1882.   Drgb[0]:=GetRValue(EndColor)-Trgb[0];
  1883.   Drgb[1]:=GetGValue(EndColor)-Trgb[1];
  1884.   Drgb[2]:=GetBValue(EndColor)-Trgb[2];
  1885.  
  1886.   P0:=0;
  1887.   P1:=0;
  1888.   P2:=0;
  1889.   P3:=0;
  1890.  
  1891.   tmpBrush:=0;
  1892.   OldColor:=-1;
  1893.   with tmpRect do
  1894.   Case Direction of
  1895.     gdLeftRight,
  1896.     gdRightLeft: begin
  1897.                    Size:=Right-Left;
  1898.                    P1:=Top;
  1899.                    P3:=Bottom-Top;
  1900.                    RectGradient(True);
  1901.                  end;
  1902.     gdTopBottom,
  1903.     gdBottomTop: begin
  1904.                    Size:=Bottom-Top;
  1905.                    P0:=Left;
  1906.                    P2:=Right-Left;
  1907.                    RectGradient(False);
  1908.                  end;
  1909.   else
  1910.   begin
  1911.     RectSize(tmpRect,SizeX,SizeY);
  1912.     Case Direction of
  1913.     gdFromTopLeft,
  1914.     gdFromBottomLeft:
  1915.       begin
  1916.         FromTop:=Direction=gdFromTopLeft;
  1917.         if FromTop then P1:=Top else P1:=Bottom;
  1918.         P0:=P1;
  1919.         tmpDiagonal:=Round(Sqrt(Sqr(SizeX)+Sqr(SizeY)));
  1920.         DC:=FCanvas.Handle;
  1921.         tmp1:=0;
  1922.         tmp2:=0;
  1923.         Repeat
  1924.           CalcBrushColor(tmp2,tmpDiagonal);
  1925.           PatBlt(DC,Left,P0,tmp2+1,1,PATCOPY);
  1926.           PatBlt(DC,Left+tmp2,P0,1,P1-P0,PATCOPY);
  1927.           if tmp1<SizeY then
  1928.           begin
  1929.             Inc(tmp1);
  1930.             if FromTop then Inc(P0) else Dec(P0);
  1931.           end;
  1932.           if tmp2<SizeX then Inc(tmp2);
  1933.         Until (tmp1>=SizeY) and (tmp2>=SizeX);
  1934.       end;
  1935.     gdFromCenter:
  1936.       begin
  1937.         XCenter:=SizeX shr 1;
  1938.         YCenter:=SizeY shr 1;
  1939.         tmp1:=0;
  1940.         tmp2:=0;
  1941.         tmp3:=XCenter+YCenter;
  1942.         DC:=FCanvas.Handle;
  1943.         Repeat
  1944.           CalcBrushColor((tmp1+tmp2), tmp3);
  1945.           P0:=SizeY-(2*tmp1);
  1946.           P1:=SizeX-(2*tmp2);
  1947.           tmpLeft:=Left+tmp2;
  1948.           tmpTop:=Top+tmp1;
  1949.           PatBlt(DC,tmpLeft,tmpTop,TeeGradientPrecision,P0,PATCOPY);
  1950.           PatBlt(DC,Right-tmp2-1,tmpTop,TeeGradientPrecision,P0,PATCOPY);
  1951.           PatBlt(DC,tmpLeft,tmpTop,P1,TeeGradientPrecision,PATCOPY);
  1952.           PatBlt(DC,tmpLeft,Bottom-tmp1-TeeGradientPrecision,
  1953.                     P1,TeeGradientPrecision,PATCOPY);
  1954.           if tmp1<YCenter then Inc(tmp1,TeeGradientPrecision);
  1955.           if tmp2<XCenter then Inc(tmp2,TeeGradientPrecision);
  1956.         Until (tmp1>=YCenter) and (tmp2>=XCenter);
  1957.       end;
  1958.     end;
  1959.   end;
  1960.   end;
  1961.   CleanBrushes;
  1962. end;
  1963.  
  1964. procedure TTeeCanvas3D.EraseBackground(const Rect: TRect);
  1965. begin
  1966.   {$IFDEF TEEPERF}
  1967.   Log('EraseBackGround');
  1968.   {$ENDIF}
  1969.   {$IFDEF D1}
  1970.   WinProcs.FillRect(FCanvas.Handle, Rect, FBrush.Handle);
  1971.   {$ELSE}
  1972.   Windows.FillRect(FCanvas.Handle, Rect, FBrush.Handle);
  1973.   {$ENDIF}
  1974.   {$IFDEF TEEGRAPHLIST}
  1975.   GraphListAddRect(Rect);
  1976.   {$ENDIF}
  1977. end;
  1978.  
  1979. procedure TTeeCanvas3D.FillRect(const Rect: TRect);
  1980. begin
  1981.   {$IFDEF TEEPERF}
  1982.   Log('FillRect');
  1983.   {$ENDIF}
  1984.   {$IFDEF D1}
  1985.   WinProcs.FillRect(FCanvas.Handle, Rect, FBrush.Handle);
  1986.   {$ELSE}
  1987.   Windows.FillRect(FCanvas.Handle, Rect, FBrush.Handle);
  1988.   {$ENDIF}
  1989.   {$IFDEF TEEGRAPHLIST}
  1990.   GraphListAddRect(Rect);
  1991.   {$ENDIF}
  1992. end;
  1993.  
  1994. procedure TTeeCanvas3D.Frame3D( Rect: TRect; TopColor,BottomColor: TColor;
  1995.                                   Width: Integer);
  1996. var TopRight   : TPoint;
  1997.     BottomLeft : TPoint;
  1998. begin
  1999.   {$IFDEF TEEPERF}
  2000.   Log('Frame3D');
  2001.   {$ENDIF}
  2002.   FPen.Width := 1;
  2003.   Dec(Rect.Bottom);
  2004.   Dec(Rect.Right);
  2005.   while Width > 0 do
  2006.   begin
  2007.     Dec(Width);
  2008.     with Rect do
  2009.     begin
  2010.       TopRight.X := Right;
  2011.       TopRight.Y := Top;
  2012.       BottomLeft.X := Left;
  2013.       BottomLeft.Y := Bottom;
  2014.       FPen.Color := TopColor;
  2015.       FCanvas.PolyLine([BottomLeft, TopLeft, TopRight]);
  2016.       FPen.Color := BottomColor;
  2017.       Dec(BottomLeft.X);
  2018.       FCanvas.PolyLine([TopRight, BottomRight, BottomLeft]);
  2019.     end;
  2020.     InflateRect(Rect, -1, -1);
  2021.   end;
  2022. end;
  2023.  
  2024. Function ApplyDark(Color:TColor; HowMuch:Byte):TColor;
  2025. Var r : Byte;
  2026.     g : Byte;
  2027.     b : Byte;
  2028. Begin
  2029.   {$IFDEF TEEPERF}
  2030.   Log('ApplyDark');
  2031.   {$ENDIF}
  2032.   Color:=ColorToRGB(Color);
  2033.  
  2034.   r:=Lo(Color);
  2035.   g:=Hi(Color);
  2036.   b:=Lo(Color shr 16);
  2037. {  r:=GetRValue(Color);
  2038.   g:=GetGValue(Color);
  2039.   b:=GetBValue(Color);}
  2040.  
  2041.   if r>HowMuch then r:=r-HowMuch else r:=0;
  2042.   if g>HowMuch then g:=g-HowMuch else g:=0;
  2043.   if b>HowMuch then b:=b-HowMuch else b:=0;
  2044.   result:=RGB(r,g,b);
  2045. end;
  2046.  
  2047. Function ApplyBright(Color:TColor; HowMuch:Byte):TColor;
  2048. Var r : Byte;
  2049.     g : Byte;
  2050.     b : Byte;
  2051. Begin
  2052.   {$IFDEF TEEPERF}
  2053.   Log('ApplyBright');
  2054.   {$ENDIF}
  2055.   Color:=ColorToRGB(Color);
  2056.  
  2057.   r:=Lo(Color);
  2058.   g:=Hi(Color);
  2059.   b:=Lo(Color shr 16);
  2060. {  r:=GetRValue(Color);
  2061.   g:=GetGValue(Color);
  2062.   b:=GetBValue(Color);}
  2063.  
  2064.   if (r+HowMuch)<256 then r:=r+HowMuch else r:=255;
  2065.   if (g+HowMuch)<256 then g:=g+HowMuch else g:=255;
  2066.   if (b+HowMuch)<256 then b:=b+HowMuch else b:=255;
  2067.   result:=RGB(r,g,b);
  2068. end;
  2069.  
  2070. Procedure TTeeCanvas3D.Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean);
  2071. Var OldColor : TColor;
  2072.     tmpSolid : Boolean;
  2073.  
  2074.   Procedure Dark(Quantity:Byte);
  2075.   begin
  2076.     if tmpSolid then FBrush.Color:=ApplyDark(OldColor,Quantity)
  2077.                 else BackColor:=ApplyDark(OldColor,Quantity);
  2078.   end;
  2079.  
  2080. var P0,P1,P2,P3 : TPoint;
  2081.     Points      : TFourPoints;
  2082. begin
  2083.   {$IFDEF TEEPERF}
  2084.   Log('Cube');
  2085.   {$ENDIF}
  2086.   Calc3DPoint(P0,Left,Top,z0);
  2087.   Calc3DPoint(P1,Right,Top,z0);
  2088.   Calc3DPoint(P2,Right,Bottom,z0);
  2089.   Calc3DPoint(P3,Right,Top,z1);
  2090.  
  2091.   tmpSolid:=FBrush.Style=bsSolid;
  2092.   if tmpSolid then OldColor:=FBrush.Color
  2093.               else OldColor:=BackColor;
  2094.  
  2095.   Points[0]:=P0;
  2096.   Points[1]:=P1;
  2097.   Points[2]:=P2;
  2098.  
  2099.   Calc3DPoint(Points[3],Left,Bottom,z0);
  2100.  
  2101.   {$IFDEF D1}
  2102.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2103.   {$ELSE}
  2104.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2105.   {$ENDIF}
  2106.  
  2107.   Points[0]:=P1;
  2108.   Points[1]:=P3;
  2109.   Calc3DPoint(Points[2],Right,Bottom,z1);
  2110.   Points[3]:=P2;
  2111.  
  2112.   if points[2].x>p2.x then
  2113.   begin
  2114.     if DarkSides then Dark(DarkerColorQuantity);
  2115.     {$IFDEF D1}
  2116.     WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2117.     {$ELSE}
  2118.     Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2119.     {$ENDIF}
  2120.   end
  2121.   else
  2122.   begin
  2123.     Points[0]:=P0;
  2124.     Calc3DPoint(Points[1],Left,Top,z1);
  2125.     Calc3DPoint(Points[2],Left,Bottom,z1);
  2126.     Calc3DPoint(Points[3],Left,Bottom,z0);
  2127.  
  2128.     if DarkSides then Dark(DarkerColorQuantity);
  2129.     {$IFDEF D1}
  2130.     WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2131.     {$ELSE}
  2132.     Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2133.     {$ENDIF}
  2134.   end;
  2135.  
  2136.   Points[0]:=P0;
  2137.   Points[1]:=P1;
  2138.   Points[2]:=P3;
  2139.   Calc3DPoint(Points[3],Left,Top,z1);
  2140.  
  2141.   if p1.y>points[3].y then
  2142.   begin
  2143.     if DarkSides then Dark(DarkColorQuantity);
  2144.     {$IFDEF D1}
  2145.     WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2146.     {$ELSE}
  2147.     Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2148.     {$ENDIF}
  2149.   end;
  2150. end;
  2151.  
  2152. Procedure TTeeCanvas3D.RectangleZ(Left,Top,Bottom,Z0,Z1:Integer);
  2153. var Points : TFourPoints;
  2154. begin
  2155.   {$IFDEF TEEPERF}
  2156.   Log('RectangleZ');
  2157.   {$ENDIF}
  2158.   Calc3DPoint(Points[0],Left,Top,Z0);
  2159.   Calc3DPoint(Points[1],Left,Top,Z1);
  2160.   Calc3DPoint(Points[2],Left,Bottom,Z1);
  2161.   Calc3DPoint(Points[3],Left,Bottom,Z0);
  2162.   {$IFDEF D1}
  2163.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2164.   {$ELSE}
  2165.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2166.   {$ENDIF}
  2167.   {$IFDEF TEEGRAPHLIST}
  2168.   GraphListAddPoly(@Points,4);
  2169.   {$ENDIF}
  2170. end;
  2171.  
  2172. Procedure TTeeCanvas3D.RectangleY(Left,Top,Right,Z0,Z1:Integer);
  2173. var Points : TFourPoints;
  2174. begin
  2175.   {$IFDEF TEEPERF}
  2176.   Log('RectangleY');
  2177.   {$ENDIF}
  2178.   Calc3DPoint(Points[0],Left,Top,Z0);
  2179.   Calc3DPoint(Points[1],Right,Top,Z0);
  2180.   Calc3DPoint(Points[2],Right,Top,Z1);
  2181.   Calc3DPoint(Points[3],Left,Top,Z1);
  2182.   {$IFDEF D1}
  2183.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2184.   {$ELSE}
  2185.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2186.   {$ENDIF}
  2187.   {$IFDEF TEEGRAPHLIST}
  2188.   GraphListAddPoly(@Points,4);
  2189.   {$ENDIF}
  2190. end;
  2191.  
  2192. procedure TTeeCanvas3D.FrontPlaneBegin;
  2193. begin
  2194.   {$IFDEF TEEPERF}
  2195.   Log('FrontPlaneBegin');
  2196.   {$ENDIF}
  2197.   FWas3D:=FIs3D;
  2198.   FIs3D:=False;
  2199. end;
  2200.  
  2201. procedure TTeeCanvas3D.FrontPlaneEnd;
  2202. begin
  2203.   {$IFDEF TEEPERF}
  2204.   Log('FrontPlaneEnd');
  2205.   {$ENDIF}
  2206.   FIs3D:=FWas3D;
  2207. end;
  2208.  
  2209. Procedure TTeeCanvas3D.Invalidate;
  2210. begin
  2211.   {$IFDEF TEEPERF}
  2212.   Log('Invalidate');
  2213.   {$ENDIF}
  2214.   FDirty:=True;
  2215. end;
  2216.  
  2217. procedure TTeeCanvas3D.RotateLabel3D(x,y,z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; Const St:String; RotDegree:Integer);
  2218. begin
  2219.   {$IFDEF TEEPERF}
  2220.   Log('RotateLabel3D');
  2221.   {$ENDIF}
  2222.   Calc3DPos(x,y,z);
  2223.   RotateLabel(x,y,St,RotDegree);
  2224. end;
  2225.  
  2226. procedure TTeeCanvas3D.RotateLabel(x,y:Integer; Const St:String; RotDegree:Integer);
  2227. var OldFont: HFONT;
  2228.     NewFont: HFONT;
  2229.     LogRec : TLOGFONT;
  2230.     DC     : HDC;
  2231. begin
  2232.   {$IFDEF TEEPERF}
  2233.   Log('RotateLabel');
  2234.   {$ENDIF}
  2235.   if RotDegree>360 then RotDegree:=RotDegree-360;
  2236.   FBrush.Style := bsClear;
  2237.   DC:=FCanvas.Handle;
  2238.   GetObject(FFont.Handle, SizeOf(LogRec), @LogRec);
  2239.   LogRec.lfEscapement   := RotDegree*10;
  2240.   LogRec.lfOrientation  := RotDegree*10; { <-- fix, was zero }
  2241.   LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
  2242.   if IZoomText then
  2243.   if IZoomFactor<>1 then
  2244.      LogRec.lfHeight    := -MulDiv( MaxLong(1,Round(IZoomFactor*FFont.Size)),
  2245.                             FFont.PixelsPerInch, 72);
  2246.   NewFont := CreateFontIndirect(LogRec);
  2247.   OldFont := SelectObject(DC,NewFont);
  2248.   {$IFDEF D1}
  2249.   WinProcs.TextOut(DC,X,Y,@St[1],Length(St));
  2250.   {$ELSE}
  2251.   Windows.TextOut(DC,X,Y,@St[1],Length(St));
  2252.   {$ENDIF}
  2253.   DeleteObject(SelectObject(DC,OldFont));
  2254.   {$IFDEF TEEGRAPHLIST}
  2255.   GraphListAddTextOut(x,y,St);
  2256.   {$ENDIF}
  2257. end;
  2258.  
  2259. Procedure TTeeCanvas3D.Line(X0,Y0,X1,Y1:Integer);
  2260. var DC : HDC;
  2261. begin
  2262.   {$IFDEF TEEPERF}
  2263.   Log('Line');
  2264.   {$ENDIF}
  2265.   DC:=FCanvas.Handle;
  2266.   {$IFDEF D1}
  2267.   WinProcs.MoveToEx(DC,X0,Y0,nil);
  2268.   WinProcs.LineTo(DC,X1,Y1);
  2269.   {$ELSE}
  2270.   Windows.MoveToEx(DC,X0,Y0,nil);
  2271.   Windows.LineTo(DC,X1,Y1);
  2272.   {$ENDIF}
  2273.   {$IFDEF TEEGRAPHLIST}
  2274.   GraphListAddMoveTo(x0,y0);
  2275.   GraphListAddLineTo(x1,y1);
  2276.   {$ENDIF}
  2277. end;
  2278.  
  2279. Procedure TTeeCanvas3D.LineWithZ(X0,Y0,X1,Y1,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  2280. var DC : HDC;
  2281. begin
  2282.   {$IFDEF TEEPERF}
  2283.   Log('LineWithZ');
  2284.   {$ENDIF}
  2285.   Calc3DPos(x0,y0,z);
  2286.   Calc3DPos(x1,y1,z);
  2287.   DC:=FCanvas.Handle;
  2288.   {$IFDEF D1}
  2289.   WinProcs.MoveToEx(DC,X0,Y0,nil);
  2290.   WinProcs.LineTo(DC,X1,Y1);
  2291.   {$ELSE}
  2292.   Windows.MoveToEx(DC,X0,Y0,nil);
  2293.   Windows.LineTo(DC,X1,Y1);
  2294.   {$ENDIF}
  2295.   {$IFDEF TEEGRAPHLIST}
  2296.   GraphListAddMoveTo(x0,y0);
  2297.   GraphListAddLineTo(x1,y1);
  2298.   {$ENDIF}
  2299. end;
  2300.  
  2301. Procedure TTeeCanvas3D.Polygon(const Points: array of TPoint);
  2302. Begin
  2303.   {$IFDEF TEEPERF}
  2304.   Log('Polygon');
  2305.   {$ENDIF}
  2306.   {$IFDEF D1}
  2307.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  2308.   {$ELSE}
  2309.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  2310.   {$ENDIF}
  2311.   {$IFDEF TEEGRAPHLIST}
  2312.   GraphListAddPoly(@Points,High(Points)+1);
  2313.   {$ENDIF}
  2314. end;
  2315.  
  2316. procedure TTeeCanvas3D.Ellipse(X1, Y1, X2, Y2: Integer);
  2317. begin
  2318.   {$IFDEF TEEPERF}
  2319.   Log('Ellipse');
  2320.   {$ENDIF}
  2321.   FCanvas.Ellipse(X1,Y1,X2,Y2);
  2322. end;
  2323.  
  2324. procedure TTeeCanvas3D.EllipseWithZ(X1, Y1, X2, Y2, Z: {$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  2325. Const PiStep=Pi*0.1;
  2326.       NumCirclePoints=32;
  2327. Var P       : Array[0..NumCirclePoints-1] of TPoint;
  2328.     Points  : Array[0..2] of TPoint;
  2329.     PCenter : TPoint;
  2330.     t       : Integer;
  2331.     XRadius : Integer;
  2332.     YRadius : Integer;
  2333.     tmpSin  : Extended;
  2334.     tmpCos  : Extended;
  2335.     Old     : TPenStyle;
  2336.     DC      : HDC;
  2337. begin
  2338.   {$IFDEF TEEPERF}
  2339.   Log('EllipseWithZ');
  2340.   {$ENDIF}
  2341.   if FIsOrthogonal then
  2342.   begin
  2343.     Calc3DPos(X1,Y1,Z);
  2344.     Calc3DPos(X2,Y2,Z);
  2345.     FCanvas.Ellipse(X1,Y1,X2,Y2);
  2346.   end
  2347.   else
  2348.   if FIs3D then
  2349.   begin
  2350.     PCenter.X:=(X2+X1) div 2;
  2351.     PCenter.Y:=(Y2+Y1) div 2;
  2352.     XRadius:=(X2-X1) div 2;
  2353.     YRadius:=(Y2-Y1) div 2;
  2354.     Calc3DPoint(P[0],PCenter.X,Y2,Z);
  2355.     for t:=1 to NumCirclePoints-1 do
  2356.     begin
  2357.       SinCos(t*piStep,tmpSin,tmpCos);
  2358.       Calc3DPoint(P[t],PCenter.X+Trunc(XRadius*tmpSin),PCenter.Y+Trunc(YRadius*tmpCos),Z);
  2359.     end;
  2360.     if FBrush.Style<>bsClear then
  2361.     begin
  2362.       Old:=FPen.Style;
  2363.       FPen.Style:=psClear;
  2364.       Calc3DTPoint(PCenter,{PCenter.X,PCenter.Y,}Z);
  2365.       Points[0]:=PCenter;
  2366.       Points[1]:=P[0];
  2367.       Points[2]:=P[1];
  2368.       DC:=Handle;
  2369.       {$IFDEF D1}
  2370.       WinProcs.Polygon(DC, PPoints(@Points)^, 3);
  2371.       {$ELSE}
  2372.       Windows.Polygon(DC, PPoints(@Points)^, 3);
  2373.       {$ENDIF}
  2374.       Points[1]:=P[1];
  2375.       for t:=2 to NumCirclePoints-1 do
  2376.       begin
  2377.         Points[2]:=P[t];
  2378.         {$IFDEF D1}
  2379.         WinProcs.Polygon(DC, PPoints(@Points)^, 3);
  2380.         {$ELSE}
  2381.         Windows.Polygon(DC, PPoints(@Points)^, 3);
  2382.         {$ENDIF}
  2383.         Points[1]:=P[t];
  2384.       end;
  2385.       FPen.Style:=Old;
  2386.     end;
  2387.     if FPen.Style<>psClear then FCanvas.PolyLine(P);
  2388.   end
  2389.   else FCanvas.Ellipse(X1,Y1,X2+1,Y2+1);
  2390. end;
  2391.  
  2392. procedure TTeeCanvas3D.SetPixel(X, Y: Integer; Value: TColor);
  2393. begin
  2394.   {$IFDEF TEEPERF}
  2395.   Log('SetPixel');
  2396.   {$ENDIF}
  2397.   FCanvas.Pixels[X,Y]:=Value;
  2398. end;
  2399.  
  2400. procedure TTeeCanvas3D.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  2401. begin
  2402.   {$IFDEF TEEPERF}
  2403.   Log('Arc');
  2404.   {$ENDIF}
  2405.   FCanvas.Arc(X1,Y1,X2,Y2,X3,Y3,X4,Y4);
  2406. end;
  2407.  
  2408. procedure TTeeCanvas3D.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  2409. begin
  2410.   {$IFDEF TEEPERF}
  2411.   Log('Pie');
  2412.   {$ENDIF}
  2413.   FCanvas.Pie(X1,Y1,X2,Y2,X3,Y3,X4,Y4);
  2414. end;
  2415.  
  2416. procedure TTeeCanvas3D.Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
  2417.                               Const StartAngle,EndAngle:Double;
  2418.                               DarkSides,DrawSides:Boolean);
  2419. Var OldColor : TColor;
  2420.  
  2421.   Procedure Dark(Quantity:Byte);
  2422.   begin
  2423.     if FBrush.Style=bsSolid then
  2424.        FBrush.Color:=ApplyDark(OldColor,Quantity)
  2425.     else
  2426.        BackColor:=ApplyDark(OldColor,Quantity);
  2427.   end;
  2428.  
  2429. Const MaxCircleSteps=32;
  2430. var Points      : Array[0..MaxCircleSteps] of TPoint;
  2431.     Points3D    : Array[1..2*MaxCircleSteps] of TPoint;
  2432.     Start3D,
  2433.     End3D,
  2434.     CircleSteps : Integer;
  2435.  
  2436.   Procedure Draw3DPie;
  2437.   var t,tt:Integer;
  2438.   begin
  2439.     if DarkSides then Dark(32);
  2440.     if (Start3D=1) and (End3D=CircleSteps) then
  2441.     begin
  2442.       for t:=1 to CircleSteps do Points3D[t]:=Points[t];
  2443.       tt:=CircleSteps;
  2444.     end
  2445.     else
  2446.     begin
  2447.       tt:=0;
  2448.       for t:=Start3D to End3D do
  2449.       begin
  2450.         inc(tt);
  2451.         Points3D[tt]:=Points[t];
  2452.         Points3D[End3D-Start3D+1+tt]:=Points3D[2*CircleSteps-End3D+tt];
  2453.       end;
  2454.     end;
  2455.     {$IFDEF D1}
  2456.     WinProcs.Polygon(FCanvas.Handle, PPoints(@Points3D)^, 2*tt);
  2457.     {$ELSE}
  2458.     Windows.Polygon(FCanvas.Handle, PPoints(@Points3D)^, 2*tt);
  2459.     {$ENDIF}
  2460.   end;
  2461.  
  2462. Var tmpAngle,
  2463.     tmpSin,
  2464.     tmpCos  : Extended;
  2465.     Step    : Double;
  2466.     Started,
  2467.     Ended   : Boolean;
  2468.     t,
  2469.     tt,
  2470.     tmpX,
  2471.     tmpY    : Integer;
  2472. begin
  2473.   {$IFDEF TEEPERF}
  2474.   Log('Pie3D');
  2475.   {$ENDIF}
  2476.   CircleSteps:=32;
  2477.   Calc3DPoint(Points[0],XCenter,YCenter,Z1);
  2478.   Step:=(EndAngle-StartAngle)/(CircleSteps-1);
  2479.   tmpAngle:=StartAngle;
  2480.   for t:=1 to CircleSteps do
  2481.   begin
  2482.     SinCos(tmpAngle,tmpSin,tmpCos);
  2483.     tmpX:=XCenter+Round(XRadius*tmpCos);
  2484.     tmpY:=YCenter-Round(YRadius*tmpSin);
  2485.     Calc3DPoint(Points[t],tmpX,tmpY,Z1);
  2486.     Calc3DPoint(Points3D[2*CircleSteps+1-t],tmpX,tmpY,Z0);
  2487.     tmpAngle:=tmpAngle+Step;
  2488.   end;
  2489.  
  2490.   if FBrush.Style=bsSolid then OldColor:=FBrush.Color
  2491.                           else OldColor:=BackColor;
  2492.  
  2493.   { side }
  2494.   if DrawSides then
  2495.   begin
  2496.     if Points[CircleSteps].X<XCenter then
  2497.     begin
  2498.       Points3D[1]:=Points[0];
  2499.       Points3D[2]:=Points[CircleSteps];
  2500.       Points3D[3]:=Points3D[CircleSteps+1];
  2501.       Calc3DPoint(Points3D[4],XCenter,YCenter,Z0);
  2502.       if DarkSides then Dark(32);
  2503.       {$IFDEF D1}
  2504.       WinProcs.Polygon(FCanvas.Handle, PPoints(@Points3D)^, 4);
  2505.       {$ELSE}
  2506.       Windows.Polygon(FCanvas.Handle, PPoints(@Points3D)^, 4);
  2507.       {$ENDIF}
  2508.     end;
  2509.  
  2510.     { side }
  2511.     if Points[1].X>XCenter then
  2512.     begin
  2513.       Points3D[1]:=Points[0];
  2514.       Points3D[2]:=Points[1];
  2515.       Points3D[3]:=Points3D[2*CircleSteps];
  2516.       Calc3DPoint(Points3D[4],XCenter,YCenter,Z0);
  2517.       if DarkSides then Dark(32);
  2518.       {$IFDEF D1}
  2519.       WinProcs.Polygon(FCanvas.Handle, PPoints(@Points3D)^, 4);
  2520.       {$ELSE}
  2521.       Windows.Polygon(FCanvas.Handle, PPoints(@Points3D)^, 4);
  2522.       {$ENDIF}
  2523.     end;
  2524.   end;
  2525.  
  2526.   { 2d pie }
  2527.   if FBrush.Style=bsSolid then FBrush.Color:=OldColor
  2528.                           else BackColor:=OldColor;
  2529.   {$IFDEF D1}
  2530.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, CircleSteps+1);
  2531.   {$ELSE}
  2532.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, CircleSteps+1);
  2533.   {$ENDIF}
  2534.  
  2535.   { 3d pie }
  2536.   Ended:=False;
  2537.   Start3D:=0;
  2538.   End3D:=0;
  2539.   for t:=2 to CircleSteps do
  2540.   begin
  2541.     if Points[t].X>Points[t-1].X then
  2542.     begin
  2543.       Start3D:=t-1;
  2544.       Started:=True;
  2545.       for tt:=t+1 to CircleSteps-1 do
  2546.       if Points[tt+1].X<Points[tt].X then
  2547.       begin
  2548.         End3D:=tt;
  2549.         Ended:=True;
  2550.         Break;
  2551.       end;
  2552.       if (not Ended) and (Points[CircleSteps].X>=Points[CircleSteps-1].X) then
  2553.       begin
  2554.         End3D:=CircleSteps;
  2555.         Ended:=True;
  2556.       end;
  2557.       if Started and Ended then Draw3DPie;
  2558.       if End3D<>CircleSteps then
  2559.       if Points[CircleSteps].X>Points[CircleSteps-1].X then
  2560.       begin
  2561.         End3D:=CircleSteps;
  2562.         tt:=CircleSteps-1;
  2563.         While (Points[tt].X>Points[tt-1].X) do
  2564.         begin
  2565.           Dec(tt);
  2566.           if tt=1 then break;
  2567.         end;
  2568.         if tt>1 then
  2569.         begin
  2570.           Start3D:=tt;
  2571.           Draw3DPie;
  2572.         end;
  2573.       end;
  2574.       Break;
  2575.     end;
  2576.   end;
  2577. end;
  2578.  
  2579. procedure TTeeCanvas3D.Plane3D(Const A,B:TPoint; Z0,Z1:Integer);
  2580. var Points : TFourPoints;
  2581. begin
  2582.   {$IFDEF TEEPERF}
  2583.   Log('Plane3D');
  2584.   {$ENDIF}
  2585.   Calc3DPoint(Points[0],A.X,A.Y,Z0);
  2586.   Calc3DPoint(Points[1],B.X,B.Y,Z0);
  2587.   Calc3DPoint(Points[2],B.X,B.Y,Z1);
  2588.   Calc3DPoint(Points[3],A.X,A.Y,Z1);
  2589.   {$IFDEF D1}
  2590.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2591.   {$ELSE}
  2592.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2593.   {$ENDIF}
  2594. end;
  2595.  
  2596. procedure TTeeCanvas3D.Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer; Dark3D:Boolean);
  2597. Const NumCylinderSides=16;
  2598.       Step=2.0*pi/NumCylinderSides;
  2599.       StepColor=256 div NumCylinderSides;
  2600.  
  2601. Var OldColor : TColor;
  2602.  
  2603.   Procedure Dark(Quantity:Byte);
  2604.   begin
  2605.     if FBrush.Style=bsSolid then FBrush.Color:=ApplyDark(OldColor,Quantity)
  2606.                             else BackColor:=ApplyDark(OldColor,Quantity)
  2607.   end;
  2608.  
  2609. var tmpSize,
  2610.     tmpMid,
  2611.     tmpMidZ,
  2612.     Radius,
  2613.     ZRadius,
  2614.     t,
  2615.     NumSide :Longint;
  2616.     Poly    :Array[1..NumCylinderSides] of TPoint3D;
  2617.     tmpPoly :Array[1..NumCylinderSides] of TPoint;
  2618.     tmpSin,
  2619.     tmpCos  :Extended;
  2620. Begin
  2621.   {$IFDEF TEEPERF}
  2622.   Log('Cylinder');
  2623.   {$ENDIF}
  2624.   if FBrush.Style=bsSolid then OldColor:=FBrush.Color
  2625.                           else OldColor:=BackColor;
  2626.   ZRadius:=(Z1-Z0) shr 1;
  2627.   tmpMidZ:=(Z1+Z0) shr 1;
  2628.   if Vertical then
  2629.   begin
  2630.     Radius:=(Right-Left) shr 1;
  2631.     tmpMid:=(Right+Left) shr 1;
  2632.     for t:=1 to NumCylinderSides do
  2633.     begin
  2634.       SinCos((t-4)*Step,tmpSin,tmpCos);
  2635.       Poly[t].X:=tmpMid+Round(tmpSin*Radius);
  2636.       if Top<Bottom then Poly[t].Y:=Top
  2637.                     else Poly[t].Y:=Bottom;
  2638.       Poly[t].Z:=tmpMidZ-Round(tmpCos*ZRadius);
  2639.     end;
  2640.  
  2641.     tmpSize:=Abs(Bottom-Top);
  2642.  
  2643.     tmpPoly[1]:=Calc3DTPoint3D(Poly[1]);
  2644.     With Poly[1] do Calc3DPoint(tmpPoly[2],x,y+tmpSize,z);
  2645.     NumSide:=0;
  2646.     for t:=2 to NumCylinderSides do
  2647.     begin
  2648.       tmpPoly[4]:=Calc3DTPoint3D(Poly[t]);
  2649.       With Poly[t] do Calc3DPoint(tmpPoly[3],x,y+tmpSize,z);
  2650.  
  2651.       if tmpPoly[4].x>tmpPoly[1].x then
  2652.       begin
  2653.         if Dark3D then Dark(StepColor*NumSide);
  2654.         {$IFDEF D1}
  2655.         WinProcs.Polygon(FCanvas.Handle, PPoints(@tmpPoly)^, 4);
  2656.         {$ELSE}
  2657.         Windows.Polygon(FCanvas.Handle, PPoints(@tmpPoly)^, 4);
  2658.         {$ENDIF}
  2659.         Inc(NumSide);
  2660.       end;
  2661.  
  2662.       tmpPoly[1]:=tmpPoly[4];
  2663.       tmpPoly[2]:=tmpPoly[3];
  2664.     end;
  2665.   end
  2666.   else
  2667.   begin
  2668.     Radius:=(Bottom-Top) shr 1;
  2669.     tmpMid:=(Bottom+Top) shr 1;
  2670.     for t:=1 to NumCylinderSides do
  2671.     begin
  2672.       SinCos((t+5)*Step,tmpSin,tmpCos);
  2673.       if Left<Right then Poly[t].X:=Right
  2674.                     else Poly[t].X:=Left;
  2675.       Poly[t].Y:=tmpMid+Round(tmpSin*Radius);
  2676.       Poly[t].Z:=tmpMidZ-Round(tmpCos*ZRadius);
  2677.     end;
  2678.  
  2679.     tmpSize:=Abs(Right-Left);
  2680.  
  2681.     tmpPoly[1]:=Calc3DTPoint3D(Poly[1]);
  2682.     With Poly[1] do Calc3DPoint(tmpPoly[2],x-tmpSize,y,z);
  2683.     NumSide:=0;
  2684.     for t:=2 to NumCylinderSides-2 do
  2685.     begin
  2686.       tmpPoly[4]:=Calc3DTPoint3D(Poly[t]);
  2687.       With Poly[t] do Calc3DPoint(tmpPoly[3],x-tmpSize,y,z);
  2688.  
  2689.       if tmpPoly[4].y>tmpPoly[1].y then
  2690.       begin
  2691.         if Dark3D then Dark(StepColor*NumSide);
  2692.         {$IFDEF D1}
  2693.         WinProcs.Polygon(FCanvas.Handle, PPoints(@tmpPoly)^, 4);
  2694.         {$ELSE}
  2695.         Windows.Polygon(FCanvas.Handle, PPoints(@tmpPoly)^, 4);
  2696.         {$ENDIF}
  2697.         Inc(NumSide);
  2698.       end;
  2699.  
  2700.       tmpPoly[1]:=tmpPoly[4];
  2701.       tmpPoly[2]:=tmpPoly[3];
  2702.     end;
  2703.   end;
  2704.   for t:=1 to NumCylinderSides do tmpPoly[t]:=Calc3DTPoint3D(Poly[t]);
  2705.   if Dark3D then Dark(DarkColorQuantity);
  2706.   {$IFDEF D1}
  2707.   WinProcs.Polygon(FCanvas.Handle, PPoints(@tmpPoly)^, NumCylinderSides);
  2708.   {$ELSE}
  2709.   Windows.Polygon(FCanvas.Handle, PPoints(@tmpPoly)^, NumCylinderSides);
  2710.   {$ENDIF}
  2711. end;
  2712.  
  2713. procedure TTeeCanvas3D.Pyramid(Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer; DarkSides:Boolean);
  2714. Var OldColor:TColor;
  2715.  
  2716.   Procedure Dark(Quantity:Byte);
  2717.   begin
  2718.     if FBrush.Style=bsSolid then FBrush.Color:=ApplyDark(OldColor,Quantity)
  2719.                             else BackColor:=ApplyDark(OldColor,Quantity)
  2720.   end;
  2721.  
  2722. Var P0,P1,P2,P3,PTop:TPoint;
  2723. begin
  2724.   {$IFDEF TEEPERF}
  2725.   Log('Pyramid');
  2726.   {$ENDIF}
  2727.   if FBrush.Style=bsSolid then OldColor:=FBrush.Color
  2728.                           else OldColor:=BackColor;
  2729.   if Vertical then
  2730.   begin
  2731.     if Top<>Bottom then
  2732.     Begin
  2733.       Calc3DPoint(P0,Left,Bottom,Z0);
  2734.       Calc3DPoint(P1,Right,Bottom,Z0);
  2735.       Calc3DPoint(PTop,(Left+Right) div 2,Top,(Z0+Z1) div Longint(2));
  2736.       Polygon([P0,PTop,P1]);
  2737.       if Top<Bottom then
  2738.       begin
  2739.         Calc3DPoint(P2,Left,Bottom,Z1);
  2740.         if P2.Y<PTop.Y then Polygon([ P0,PTop,P2] );
  2741.       end;
  2742.       if DarkSides then Dark(DarkerColorQuantity);
  2743.       Calc3DPoint(P3,Right,Bottom,Z1);
  2744.       Polygon([ P1,PTop,P3 ] );
  2745.       if (Top<Bottom) and (P2.Y<PTop.Y) then
  2746.       begin
  2747.         Calc3DPoint(P2,Left,Bottom,Z1);
  2748.         Polygon([ PTop,P2,P3 ] );
  2749.       end;
  2750.     end;
  2751.     if Top>=Bottom then
  2752.     begin
  2753.       if DarkSides then Dark(DarkColorQuantity);
  2754.       RectangleY(Left,Bottom,Right,Z0,Z1);
  2755.     end;
  2756.   end
  2757.   else
  2758.   begin
  2759.     if Left<>Right then
  2760.     Begin
  2761.       Calc3DPoint(P0,Left,Top,Z0);
  2762.       Calc3DPoint(P1,Left,Bottom,Z0);
  2763.       Calc3DPoint(PTop,Right,(Top+Bottom) shr 1,(Z0+Z1) shr 1);
  2764.       Polygon([P0,PTop,P1]);
  2765.       if DarkSides then Dark(DarkColorQuantity);
  2766.       Calc3DPoint(P2,Left,Top,Z1);
  2767.       Polygon([ P0,PTop,P2 ] );
  2768.     end;
  2769.     if Left>=Right then
  2770.     begin
  2771.       if DarkSides then Dark(DarkerColorQuantity);
  2772.       RectangleZ(Left,Top,Bottom,Z0,Z1);
  2773.     end;
  2774.   end;
  2775. end;
  2776.  
  2777. procedure TTeeCanvas3D.PlaneFour3D(Points:TFourPoints; Z0,Z1:Integer);
  2778. begin
  2779.   {$IFDEF TEEPERF}
  2780.   Log('PlaneFour3D');
  2781.   {$ENDIF}
  2782.   Calc3DTPoint(Points[0],z0);
  2783.   Calc3DTPoint(Points[1],z0);
  2784.   Calc3DTPoint(Points[2],z1);
  2785.   Calc3DTPoint(Points[3],z1);
  2786.   {$IFDEF D1}
  2787.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2788.   {$ELSE}
  2789.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 4);
  2790.   {$ENDIF}
  2791. end;
  2792.  
  2793. procedure TTeeCanvas3D.SetPixel3D(X,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF}; Value: TColor);
  2794. var DC:HDC;
  2795. begin
  2796.   {$IFDEF TEEPERF}
  2797.   Log('SetPixel3D');
  2798.   {$ENDIF}
  2799.   Calc3DPos(X,Y,Z);
  2800.   if FPen.Width=1 then FCanvas.Pixels[X,Y]:=Value
  2801.   else
  2802.   begin { simulate a big dot pixel }
  2803.     DC:=FCanvas.Handle;
  2804.     {$IFDEF D1}
  2805.     WinProcs.MoveToEx(DC, X, Y, nil);
  2806.     WinProcs.LineTo(DC,X,Y);
  2807.     {$ELSE}
  2808.     Windows.MoveToEx(DC, X, Y, nil);
  2809.     Windows.LineTo(DC,X,Y);
  2810.     {$ENDIF}
  2811.   end;
  2812. end;
  2813.  
  2814. Function TTeeCanvas3D.GetSupports3DText:Boolean;
  2815. begin
  2816.   {$IFDEF TEEPERF}
  2817.   Log('GetSupports3DText');
  2818.   {$ENDIF}
  2819.   result:=False;
  2820. end;
  2821.  
  2822. Function TTeeCanvas3D.GetSupportsFullRotation:Boolean;
  2823. begin
  2824.   {$IFDEF TEEPERF}
  2825.   Log('GetSupportsFullRotation');
  2826.   {$ENDIF}
  2827.   result:=False;
  2828. end;
  2829.  
  2830. Function TTeeCanvas3D.GetTextAlign:TCanvasTextAlign;
  2831. begin
  2832.   {$IFDEF TEEPERF}
  2833.   Log('GetTextAlign');
  2834.   {$ENDIF}
  2835.   {$IFDEF D1}
  2836.   result:=WinProcs.GetTextAlign(FCanvas.Handle);
  2837.   {$ELSE}
  2838.   result:=Windows.GetTextAlign(FCanvas.Handle);
  2839.   {$ENDIF}
  2840. end;
  2841.  
  2842. Function TTeeCanvas3D.GetUseBuffer:Boolean;
  2843. begin
  2844.   {$IFDEF TEEPERF}
  2845.   Log('GetUseBuffer');
  2846.   {$ENDIF}
  2847.   result:=FBufferedDisplay;
  2848. end;
  2849.  
  2850. Procedure TTeeCanvas3D.SetUseBuffer(Value:Boolean);
  2851. begin
  2852.   {$IFDEF TEEPERF}
  2853.   Log('SetUseBuffer');
  2854.   {$ENDIF}
  2855.   FBufferedDisplay:=Value;
  2856.   if (not FBufferedDisplay) and Assigned(FBitmap) then
  2857.   begin
  2858.     FBitmap.Free;
  2859.     FBitmap:=nil;
  2860.     FDirty:=True;
  2861.   end;
  2862. end;
  2863.  
  2864. Function TTeeCanvas3D.GetMonochrome:Boolean;
  2865. begin
  2866.   {$IFDEF TEEPERF}
  2867.   Log('GetMonochrome');
  2868.   {$ENDIF}
  2869.   result:=FMonochrome;
  2870. end;
  2871.  
  2872. Procedure TTeeCanvas3D.SetMonochrome(Value:Boolean);
  2873. begin
  2874.   {$IFDEF TEEPERF}
  2875.   Log('SetMonochrome');
  2876.   {$ENDIF}
  2877.   if FMonochrome<>Value then
  2878.   begin
  2879.     FMonochrome:=Value;
  2880.     FBitmap.Free;
  2881.     FBitmap:=nil;
  2882.     FDirty:=True;
  2883.     if Assigned(F3DOptions) then F3DOptions.Repaint;
  2884.   end;
  2885. end;
  2886.  
  2887. Procedure TTeeCanvas3D.HorizLine3D(Left,Right,Y,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  2888. var DC   : HDC;
  2889.     tmpY :{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF};
  2890. begin
  2891.   {$IFDEF TEEPERF}
  2892.   Log('HorizLine3D');
  2893.   {$ENDIF}
  2894.   tmpY:=Y;
  2895.   Calc3DPos(Left,tmpY,Z);
  2896.   DC:=FCanvas.Handle;
  2897.   {$IFDEF D1}
  2898.   WinProcs.MoveToEx(DC,Left,tmpY,nil);
  2899.   {$ELSE}
  2900.   Windows.MoveToEx(DC,Left,tmpY,nil);
  2901.   {$ENDIF}
  2902.   tmpY:=Y;
  2903.   Calc3DPos(Right,tmpY,Z);
  2904.   {$IFDEF D1}
  2905.   WinProcs.LineTo(DC,Right,tmpY);
  2906.   {$ELSE}
  2907.   Windows.LineTo(DC,Right,tmpY);
  2908.   {$ENDIF}
  2909. end;
  2910.  
  2911. Procedure TTeeCanvas3D.VertLine3D(X,Top,Bottom,Z:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  2912. var DC   : HDC;
  2913.     tmpX :{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF};
  2914. begin
  2915.   {$IFDEF TEEPERF}
  2916.   Log('VertLine3D');
  2917.   {$ENDIF}
  2918.   tmpX:=X;
  2919.   Calc3DPos(tmpX,Top,Z);
  2920.   DC:=FCanvas.Handle;
  2921.   {$IFDEF D1}
  2922.   WinProcs.MoveToEx(DC,tmpX,Top,nil);
  2923.   {$ELSE}
  2924.   Windows.MoveToEx(DC,tmpX,Top,nil);
  2925.   {$ENDIF}
  2926.   tmpX:=X;
  2927.   Calc3DPos(tmpX,Bottom,Z);
  2928.   {$IFDEF D1}
  2929.   WinProcs.LineTo(DC,tmpX,Bottom);
  2930.   {$ELSE}
  2931.   Windows.LineTo(DC,tmpX,Bottom);
  2932.   {$ENDIF}
  2933. end;
  2934.  
  2935. Procedure TTeeCanvas3D.ZLine3D(X,Y,Z0,Z1:{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF});
  2936. var DC   : HDC;
  2937.     tmpX,
  2938.     tmpY :{$IFDEF D2C1}Longint{$ELSE}Integer{$ENDIF};
  2939. begin
  2940.   {$IFDEF TEEPERF}
  2941.   Log('ZLine3D');
  2942.   {$ENDIF}
  2943.   tmpX:=X;
  2944.   tmpY:=Y;
  2945.   Calc3DPos(tmpX,tmpY,Z0);
  2946.   DC:=FCanvas.Handle;
  2947.   {$IFDEF D1}
  2948.   WinProcs.MoveToEx(DC,tmpX,tmpY,nil);
  2949.   {$ELSE}
  2950.   Windows.MoveToEx(DC,tmpX,tmpY,nil);
  2951.   {$ENDIF}
  2952.   tmpX:=X;
  2953.   tmpY:=Y;
  2954.   Calc3DPos(tmpX,tmpY,Z1);
  2955.   {$IFDEF D1}
  2956.   WinProcs.LineTo(DC,tmpX,tmpY);
  2957.   {$ELSE}
  2958.   Windows.LineTo(DC,tmpX,tmpY);
  2959.   {$ENDIF}
  2960. end;
  2961.  
  2962. procedure TTeeCanvas3D.TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer);
  2963. var Points : Array[0..2] of TPoint;
  2964. begin
  2965.   {$IFDEF TEEPERF}
  2966.   Log('TriangleWithZ');
  2967.   {$ENDIF}
  2968.   Calc3DPoint(Points[0],P1.X,P1.Y,Z);
  2969.   Calc3DPoint(Points[1],P2.X,P2.Y,Z);
  2970.   Calc3DPoint(Points[2],P3.X,P3.Y,Z);
  2971.   {$IFDEF D1}
  2972.   WinProcs.Polygon(FCanvas.Handle, PPoints(@Points)^, 3);
  2973.   {$ELSE}
  2974.   Windows.Polygon(FCanvas.Handle, PPoints(@Points)^, 3);
  2975.   {$ENDIF}
  2976. end;
  2977.  
  2978. Procedure TTeeCanvas3D.Arrow( Filled:Boolean;
  2979.                               Const FromPoint,ToPoint:TPoint;
  2980.                               ArrowWidth,ArrowHeight,Z:Integer);
  2981. Var x    : Double;
  2982.     y    : Double;
  2983.     SinA : Double;
  2984.     CosA : Double;
  2985.  
  2986.     Function CalcArrowPoint:TPoint;
  2987.     Begin
  2988.       result.X:=Round( x*CosA + y*SinA);
  2989.       result.Y:=Round(-x*SinA + y*CosA);
  2990.       Calc3DTPoint(result,Z);
  2991.     end;
  2992.  
  2993. Var tmpHoriz  : Longint;
  2994.     tmpVert   : Longint;
  2995.     dx        : Longint;
  2996.     dy        : Longint;
  2997.     tmpHoriz4 : Double;
  2998.     xb        : Double;
  2999.     yb        : Double;
  3000.     l         : Double;
  3001.  
  3002.    { These are the Arrows points coordinates }
  3003.     To3D,pc,pd,pe,pf,pg,ph:TPoint;
  3004.  
  3005.     (*           pc
  3006.                    |\
  3007.     ph           pf| \
  3008.       |------------   \ ToPoint
  3009.  From |------------   /
  3010.     pg           pe| /
  3011.                    |/
  3012.                  pd
  3013.     *)
  3014. begin
  3015.   {$IFDEF TEEPERF}
  3016.   Log('Arrow');
  3017.   {$ENDIF}
  3018.   dx := ToPoint.x-FromPoint.x;
  3019.   dy := FromPoint.y-ToPoint.y;
  3020.   l  := Sqrt(1.0*dx*dx+1.0*dy*dy);
  3021.   if l>0 then  { if at least one pixel... }
  3022.   Begin
  3023.     tmpHoriz:=ArrowWidth;
  3024.     tmpVert :=MinLong(Round(l),ArrowHeight);
  3025.     SinA:= dy / l;
  3026.     CosA:= dx / l;
  3027.     xb:= ToPoint.x*CosA - ToPoint.y*SinA;
  3028.     yb:= ToPoint.x*SinA + ToPoint.y*CosA;
  3029.     x := xb - tmpVert;
  3030.     y := yb - tmpHoriz/2;
  3031.     pc:=CalcArrowPoint;
  3032.     y := yb + tmpHoriz/2;
  3033.     pd:=CalcArrowPoint;
  3034.     if Filled then
  3035.     Begin
  3036.       tmpHoriz4:=tmpHoriz/4;
  3037.       y := yb - tmpHoriz4;
  3038.       pe:=CalcArrowPoint;
  3039.       y := yb + tmpHoriz4;
  3040.       pf:=CalcArrowPoint;
  3041.       x := FromPoint.x*cosa - FromPoint.y*sina;
  3042.       y := yb - tmpHoriz4;
  3043.       pg:=CalcArrowPoint;
  3044.       y := yb + tmpHoriz4;
  3045.       ph:=CalcArrowPoint;
  3046.       To3D:=ToPoint;
  3047.       Calc3DTPoint(To3D,Z);
  3048.       Polygon([ ph,pg,pe,pc,To3D,pd,pf ]);
  3049.     end
  3050.     else
  3051.     begin
  3052.       MoveTo3D(FromPoint.x,FromPoint.y,z);
  3053.       LineTo3D(ToPoint.x,ToPoint.y,z);
  3054.       LineTo3D(pd.x,pd.y,z);
  3055.       MoveTo3D(ToPoint.x,ToPoint.y,z);
  3056.       LineTo3D(pc.x,pc.y,z);
  3057.     end;
  3058.   end;
  3059. end;
  3060.  
  3061. { Util functions }
  3062. Function MaxDouble(Const a,b:Double):Double;
  3063. begin
  3064.   if a>b then result:=a else result:=b;
  3065. end;
  3066.  
  3067. Function MinDouble(Const a,b:Double):Double;
  3068. begin
  3069.   if a<b then result:=a else result:=b;
  3070. end;
  3071.  
  3072. Function MaxLong(a,b:Longint):Longint;
  3073. begin
  3074.   if a>b then result:=a else result:=b;
  3075. end;
  3076.  
  3077. Function MinLong(a,b:Longint):Longint;
  3078. begin
  3079.   if a>b then result:=b else result:=a;
  3080. end;
  3081.  
  3082. Procedure SwapLongint(Var a,b:Longint);
  3083. var tmp : Longint;
  3084. Begin
  3085.   Tmp:=a;  a:=b;  b:=Tmp;
  3086. End;
  3087.  
  3088. Procedure SwapDouble(Var a,b:Double);
  3089. var tmp : Double;
  3090. begin
  3091.   tmp:=a;  a:=b;  b:=tmp;
  3092. end;
  3093.  
  3094. Procedure SwapInteger(Var a,b:Integer);
  3095. var tmp : Integer;
  3096. Begin
  3097.   tmp:=a; a:=b; b:=tmp;
  3098. end;
  3099.  
  3100. {$IFDEF TEETRIAL}
  3101. Procedure TeeTrial(ComponentState:TComponentState);
  3102. begin
  3103.   if TeeTreeMargin and (not (csDesigning in ComponentState)) then
  3104.   begin
  3105.     TeeTrialShowAboutBox(True);
  3106.     TeeTreeMargin:=False;
  3107.   end;
  3108. end;
  3109. {$ENDIF}
  3110.  
  3111. {$IFDEF TEEUSEDRAWDIB}
  3112. initialization
  3113.   hdd:=DrawDibOpen;
  3114. finalization
  3115.   DrawDibClose(hdd);
  3116. {$ENDIF}
  3117. end.
  3118.