{*********************************************}
{  TeeChart Charting Library for FireMonkey   }
{  Copyright (c) 2012 by Steema Software      }
{  All Rights Reserved                        }
{*********************************************}
unit FMXTee.Chart3D;
{$DEFINE FMX}
{$I TeeDefs.inc}

interface

{$DEFINE XE2UPDATE4}

uses
  System.Classes, System.Types, System.UITypes, System.Generics.Collections, 
  FMX.Types, FMX.Types3D, FMX.Objects3D, FMX.Layers3D,
  {$IFDEF D20}
  System.Math.Vectors,
  {$ENDIF}
  {$IFDEF D18}
  FMX.Controls3D, FMX.MaterialSources, System.RTLConsts,
  {$ENDIF}
  {$IFDEF D19}
  FMX.Graphics,
  {$ENDIF}
  FMXTee.Engine, FMXTee.Chart, FMXTee.Canvas;

type
  TCustomChart3D = class(TControl3D)
  private
    FFontDepth     : Single;

    FOnCreateChart : TNotifyEvent;

    {$IFNDEF XE2UPDATE4}
    FOnMouseEnter  : TNotifyEvent;
    FOnMouseLeave  : TNotifyEvent;
    {$ENDIF}

    function CreateChartControl:TChart;
    function FirstChart:TChart;
    function GetChart:TChart;
    function GetSeries(Index:Integer):TChartSeries;
    procedure SetupChart(const AChart:TChart);
    function GetWalls: TChartWalls;
    procedure SetFontDepth(const Value: Single);
    function GetAxes: TChartAxes;
    function GetLegend: TChartLegend;
    function GetTitle: TChartTitle;
  protected
    property FontDepth:Single read FFontDepth write SetFontDepth;

    {$IFNDEF XE2UPDATE4}
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
    {$ENDIF}

    {$IFNDEF D18}
    {$IFDEF D17}
    function DoRayCastIntersect(const RayPos, RayDir: TVector3D; var Intersection: TVector3D): Boolean; override;
    {$ENDIF}
    {$ENDIF}

    procedure ReadState(Reader: TReader); override;
    procedure Render; override;
    procedure Resize3D; override;
    procedure SetChart(const Value:TChart);
  public
    Constructor Create(AOwner:TComponent); override;

    procedure CreateChart;
    function FindControl(const AName:String):TControl3D;

    {$IFNDEF D17}
    function RayCastIntersect(const RayPos, RayDir: TVector3D; var Intersection: TVector3D): Boolean; override;
    {$ENDIF}

    property Axes:TChartAxes read GetAxes;
    property Chart:TChart read GetChart;
    property Legend:TChartLegend read GetLegend;
    property Series[Index:Integer]:TChartSeries read GetSeries; default;
    property Title:TChartTitle read GetTitle;
    property Walls:TChartWalls read GetWalls;

    property OnCreateChart:TNotifyEvent read FOnCreateChart write FOnCreateChart;

    {$IFNDEF XE2UPDATE4}
    property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    {$ENDIF}
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(TeeAllComponentPlatformIDs)]
  {$ENDIF}
  TChart3D = class(TCustomChart3D)
  published
    property Chart;

    {$IFDEF D17}
    property Cursor default crDefault;
    property DragMode default TDragMode.dmManual;

    {$IFNDEF D21} // Removed in XE7
    property DesignVisible default True;
    {$ENDIF}
    
    property Position;
    property Scale;
    property RotationAngle;
    property Locked default False;
    property Width;
    property Height;
    property Depth;
    property Opacity nodefault;
    property Projection;
    property HitTest default True;

    {$IFDEF D20}
    property VisibleContextMenu default True;
    {$ELSE}
    property ShowContextMenu default True;
    {$ENDIF}
    
    property TwoSide default False;
    property Visible default True;
    property ZWrite default True;
    property OnDragEnter;
    property OnDragLeave;
    property OnDragOver;
    property OnDragDrop;
    property OnDragEnd;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnKeyDown;
    property OnKeyUp;
    property OnRender;
    {$ENDIF}

    property OnCreateChart;
    property OnMouseEnter;
    property OnMouseLeave;
  end;

  {$IFDEF D20}
  TPoint3D=System.Math.Vectors.TPoint3D;
  {$ELSE}
  {$IFDEF D17}
  TPoint3D=System.Types.TPoint3D;
  {$ELSE}
  TPoint3D=FMX.Types3D.TPoint3D;
  {$ENDIF}
  {$ENDIF}

  {$IFDEF D16}
  [ComponentPlatformsAttribute(TeeAllComponentPlatformIDs)]
  {$ENDIF}
  TLine3D=class(TShape3D)
  private
    FStart: TPoint3D;
    FEnd: TPoint3D;

    procedure SetEnd(const Value: {$IFNDEF D17}FMX.Types3D.{$ENDIF}TPoint3D);
    procedure SetStart(const Value: {$IFNDEF D17}FMX.Types3D.{$ENDIF}TPoint3D);
  protected
    procedure Render; override;
  public
    {$IFDEF D20}
    function RayCastIntersect(const RayPos, RayDir: TPoint3D; var Intersection: TPoint3D): Boolean; override;
    {$ELSE}
    function RayCastIntersect(const RayPos, RayDir: TVector3D; var Intersection: TVector3D): Boolean; override;
    {$ENDIF}

    property StartPoint:{$IFNDEF D17}FMX.Types3D.{$ENDIF}TPoint3D read FStart write SetStart;
    property EndPoint:{$IFNDEF D17}FMX.Types3D.{$ENDIF}TPoint3D read FEnd write SetEnd;
  end;

implementation

uses
  System.Math, FMX.Objects,
  {$IFDEF D17}
  System.UIConsts, FMX.Materials,
  {$ENDIF}
  FMXTee.Procs, FMX.Dialogs, System.SysUtils;

type
  TScale3D=record
    X,Y,Z,
    Width,Height,Depth : Single;
  end;

  TFMXCanvas3D = class(TCanvas3D)
  private
    FBackColor : TColor;
    FBackMode  : TCanvasBackMode;
    FMono      : Boolean;
    FTextAlign : TCanvasTextAlign;

    FX, FY, FZ : Single;
    FVisual : TControl3D;
    FDirty  : Boolean;

    FCurrent : TControl3D;
    FTree : Array of TControl3D;

    IScale    : TScale3D;
    ItemOwner : TFmxObject;

    procedure InternalEllipse(const X1, Y1, X2, Y2, Z: Single);
    procedure InternalRect(const R:TRect; const Z:Single; Border:Boolean; RoundSize:Integer);
    procedure InternalTextOut(const x, y, z: Single; const Text: String;
                              AllowHTML: boolean);
    procedure PrepareControl3D(const Shape:TControl3D; const Left,Top,Right,Bottom,Z0,Z1:Single);
    procedure Prepare(const Shape:TShape3D; const Left,Top,Right,Bottom,Z0,Z1:Single);
    procedure SetMaterialAndName(const AShape:TShape3D);
    //procedure SetUniqueName(const AComp:TComponent);
  protected
    FontDepth : Single;

    function BeginEntity(const Entity:String; const Visual:TVisualBlock=nil; const Transform:TTeeTransform=nil):TVisualBlock; override;
    procedure EndEntity; override;

    Function GetPixel3D(X,Y,Z:Integer):TColor; override;
    Function GetSupports3DText:Boolean; override;
    procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;

    function GetBackColor:TColor; override;
    Function GetBackMode:TCanvasBackMode; override;
    Function GetIsNoBMPGrid:Boolean; override;
    Function GetMonochrome:Boolean; override;
    Function GetPixel(x,y:Integer):TColor; override;
    Function GetSupportsFullRotation:Boolean; override;
    Function GetSupportsXORMode:Boolean; override;
    Function GetTextAlign:TCanvasTextAlign; override;
    Function GetUseBuffer:Boolean; override;
    Procedure SetBackColor(const Value:TColor); override;
    Procedure SetBackMode(const Value:TCanvasBackMode); override;
    procedure SetFastLine(const Active:Boolean); override;
    Procedure SetMonochrome(Value:Boolean); override;
    procedure SetPixel(X, Y: Integer; Value: TColor); override;
    procedure SetTextAlign(const Value:TCanvasTextAlign); override;
    Procedure SetUseBuffer(Value:Boolean); override;

    procedure SmoothShadow(const Shadow:TTeeShadow; const Rect:TRect;
                           Ellipse:Boolean; RoundSize:Integer;
                           const P:Array of TPoint;
                           DonutPercent:Integer=0;
                           const StartAngle:Double=0;
                           const EndAngle:Double=360); override;
  public
    Constructor Create; override;

    Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); override;
    Function Calculate3DPosition(x,y,z:Integer):TPoint; override;
    Function Calculate3DPosition(const x,y,z:Single):TPoint; override;

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer); overload; override;
    procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                     Const StartAngle,EndAngle,HolePercent:Double); override;
    procedure Draw(X, Y: Integer; const Graphic: TGraphic); override;
    procedure Ellipse(const X1, Y1, X2, Y2: TCoordinate); overload; override;

    procedure FillRect(const R:TRect); override;

    procedure LineTo(const X,Y:TCoordinate); overload; override;
    procedure MoveTo(const X,Y:TCoordinate); overload; override;
    procedure Pie(const R:TRect; const StartAngle,EndAngle:Double); overload; override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); overload; override;
    procedure Rectangle(const X0,Y0,X1,Y1:TCoordinate); overload; override;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); overload; override;
    procedure StretchDraw(const Rect: TRect; const Graphic: TGraphic); overload; override;
    Procedure TextOut(const X,Y:TCoordinate; const Text:String); overload; override;
    procedure ClipRectangle(Const Rect:TRect); overload; override;

    procedure EraseBackground(const Rect: TRect); override;

    Procedure GradientFill( Const Rect:TRect;
                             StartColor,EndColor:TColor;
                             Direction:TGradientDirection;
                             Balance:Integer=50;
                             RadialX:Integer=0;
                             RadialY:Integer=0); overload; override;

    Procedure Invalidate; override;

    Procedure Polyline(const Points:Array of TPoint); overload; override;
    Procedure Polygon(const Points:Array of TPoint); override;
    procedure PolygonWithZ(const Points:Array of TPoint; Z:Integer); override;
    procedure RotateLabel( x,y:Integer; const St:String;
                           RotDegree:Double; AllowHTML:Boolean=False); override;  // 7.0
    Function TextWidth(Const St:String):Integer; override;
    Function TextHeight(Const St:String):Integer; override;
    procedure UnClipRectangle; override;


       // 3D
    Function InitWindow( const DestCanvas:TCanvas;
                         const A3DOptions:TView3DOptions;
                         ABackColor:TColor;
                         Is3D:Boolean;
                         const UserRect:TRect):TRect; override;

    Procedure Projection(MaxDepth:Integer; const ABounds,Rect:TRect); override;
    Procedure ShowImage( const DestCanvas,DefaultCanvas:TCanvas;
                         Const UserRect:TRect); override;
    Function ReDrawBitmap:Boolean; override;
    function RenderToBitmap(var ABitmap:TBitmap; const R:TRect):Boolean; override;

    Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
                      ArrowWidth,ArrowHeight,Z0,Z1:Integer;
                      const ArrowPercent:Double); overload; override;

    procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); override;
    procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                     Dark3D:Boolean; ConePercent:Integer); override;
    Procedure Cube( Left,Right,Top,Bottom,Z0,Z1:Integer;
                     DarkSides:Boolean=True; RoundSize:Integer=0); overload; override;
    Procedure Cube( Left,Right,Top,Bottom,Z0,Z1,BevelSize:Integer;
                     DarkSides:Boolean=True; RoundSize:Integer=0); overload; override;
    procedure Cylinder( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                         Dark3D:Boolean=True); override;
    procedure EllipseWithZ(const X1, Y1, X2, Y2:TCoordinate;
                           const Z:Integer); overload; override;
    procedure MoveTo3D(const X,Y,Z:TCoordinate); override;
    procedure LineTo3D(const X,Y,Z:TCoordinate); override;

    procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
                      Const StartAngle,EndAngle:Double;
                      DarkSides,DrawSides:Boolean;
                      DonutPercent:Integer=0;
                      Gradient:TCustomTeeGradient=nil;
                      BevelPercent:Integer=0;
                      EdgeStyle:TEdgeStyle=edNone;
                      Transparency:TTeeTransparency=0;
                      BevelBright:Integer=0;
                      BevelBorder:Boolean=True;
                      HideSides:Boolean=False); override;

    procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); override;
    procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); overload; override;
    procedure PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); override;
    Procedure Polygon3D(const Points: Array of {$IFDEF FMX}FMXTee.Canvas.{$ENDIF}TPoint3D); overload; override;
    procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
                       DarkSides:Boolean=True); override;
    Procedure PyramidTrunc(Const R:TRectF; const StartZ,EndZ,TruncX,TruncZ:Double;
                           TopCover:Boolean=True; BottomCover:Boolean=True); override;
    Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); override;
    Procedure RectangleY(const Left,Top,Right:TCoordinate;
                         const Z0,Z1:Integer); override;
    Procedure RectangleZ(const Left,Top,Bottom:TCoordinate;
                         const Z0,Z1:Integer); override;
    procedure RotateLabel3D( x,y,z:Integer; const St:String;
                             RotDegree:Double;
                             AllowHTML:Boolean=False); override;  // 7.0
    procedure Sphere(x,y,z:Integer; Const Radius:Double); overload; override;
    procedure Surface3D( Style:TTeeCanvasSurfaceStyle;
                         SameBrush,CreateCached,AddNormals:Boolean;
                         NumXValues,NumZValues:Integer;
                         const CalcPoints:TTeeCanvasCalcPoints;
                         var Cached:TTeeCachedObject); override;
    Procedure TextOut3D(x,y,z:Integer; const Text:String; AllowHTML:Boolean=False); overload; override;
    procedure Triangle3D( const Points:TTrianglePoints3D;
                           const Colors:TTriangleColors3D); override;
    procedure TriangleWithZ(const P1,P2,P3:TPoint; Z:Integer); override;
  end;

{ TChart3D }

constructor TCustomChart3D.Create(AOwner: TComponent);
begin
  inherited;

  if csDesigning in ComponentState then
     if (not Assigned(Owner)) or (not (csLoading in Owner.ComponentState)) then
        CreateChartControl;
end;

function TCustomChart3D.FindControl(const AName: String): TControl3D;

  function FindChildren(const AItem:TFmxObject):TControl3D;
  var
    t: Integer;
  begin
    if (AItem is TControl3D) and (AItem.Name=AName) then
       result:=TControl3D(AItem)
    else
    begin
      result:=nil;
      for t := 0 to AItem.ChildrenCount-1 do
      begin
        result:=FindChildren(AItem.Children[t]);
        if Assigned(result) then
           break;
      end;
    end;
  end;

var
  t: Integer;
begin
  result:=nil;

  for t := 0 to ChildrenCount-1 do
  begin
    result:=FindChildren(Children[t]);
    if Assigned(result) then
       break;
  end;
end;

function TCustomChart3D.FirstChart:TChart;
var t : Integer;
begin
  result:=nil;

  for t:=0 to ChildrenCount-1 do
      if Children[t] is TChart then
      begin
        result:=TChart(Children[t]);
        break;
      end;
end;

function TCustomChart3D.GetAxes: TChartAxes;
begin
  result:=Chart.Axes;
end;

function TCustomChart3D.GetChart: TChart;
begin
  result:=FirstChart;

  if not Assigned(result) then
     result:=CreateChartControl;
end;

function TCustomChart3D.GetLegend: TChartLegend;
begin
  result:=Chart.Legend;
end;

function TCustomChart3D.GetSeries(Index: Integer): TChartSeries;
begin
  result:=Chart[Index];
end;

function TCustomChart3D.GetTitle: TChartTitle;
begin
  result:=Chart.Title;
end;

function TCustomChart3D.GetWalls: TChartWalls;
begin
  result:=Chart.Walls;
end;

procedure TCustomChart3D.SetupChart(const AChart:TChart);
begin
  with AChart do
  begin
    Canvas:=TFMXCanvas3D.Create;
    (Canvas as TFMXCanvas3D).FVisual:=Self;
    (Canvas as TFMXCanvas3D).ItemOwner:=AChart;
    Canvas.View3DOptions:=View3DOptions;
    View3DOptions.Parent:=AChart;
    (Canvas as TFMXCanvas3D).FDirty:=True;

    Zoom.Allow:=False;
    Visible:=False;

    View3DOptions.Orthogonal:=False;
    Chart3DPercent:=100;

    CustomWidth3D:=True;
  end;

  {$IFDEF D17}
  AChart.Canvas.ReferenceCanvas:=TCanvasManager.MeasureCanvas;
  {$ELSE}
  if GetMeasureBitmap.Canvas.BeginScene then
     AChart.Canvas.ReferenceCanvas:=GetMeasureBitmap.Canvas;
  {$ENDIF}
end;

function TCustomChart3D.CreateChartControl;
begin
  result:=TChart.Create(Owner);
  result.Parent:=Self;

  if Assigned(Owner) and (result.Name='') then
     result.Name:=TeeGetUniqueName(Owner,'Chart3DChart');

  result.View3DOptions.RotationFloat:=0;
  result.View3DOptions.ElevationFloat:=0;

  result.BevelInner:=bvNone;
  result.BevelOuter:=bvNone;
  result.Color:=TAlphaColors.Null;

  result.Walls.Back.Transparent:=False;
  result.Walls.Size:=5;

  SetupChart(result);
end;

{$IFNDEF D18}
{$IFDEF D17}
function TCustomChart3D.DoRayCastIntersect(const RayPos, RayDir: TVector3D;
  var Intersection: TVector3D): Boolean;
var
  INear, IFar: TVector3D;
begin
  Result := RayCastCuboidIntersect(RayPos, RayDir, Vector3D(0,0,0), Width, Height, Depth, INear, IFar) > 0;
  if Result then
    Intersection := LocalToAbsoluteVector(INear);
end;
{$ELSE}
function TCustomChart3D.RayCastIntersect(const RayPos, RayDir: TVector3D;
  var Intersection: TVector3D): Boolean;
const
  e = 0.5 + 0.001; // Small value for floating point imprecisions

var
  p: array [0 .. 5] of TVector3D;
  CubeSize: TVector3D;
  r: TVector3D;
  i: Integer;
  t: Single;
  eSize: TVector3D;
begin

  CubeSize.V[0] := Width;
  CubeSize.V[1] := Height;
  CubeSize.V[2] := Depth;

  eSize.V[0] := Width * e;
  eSize.V[1] := Height * e;
  eSize.V[2] := Depth * e;

  p[0] := XHmgVector;
  p[1] := YHmgVector;
  p[2] := ZHmgVector;
  p[3] := Vector3D(-1, 0, 0);
  p[4] := Vector3D(0, -1, 0);
  p[5] := Vector3D(0, 0, -1);

  for i := 0 to 5 do
  begin
    if Vector3DDotProduct(p[i], RayDir) > 0 then
    begin
      t := -(p[i].V[0] * RayPos.V[0] + p[i].V[1] * RayPos.V[1] + p[i].V[2] * RayPos.V[2] + 0.5 * CubeSize.V[i mod 3]) /
            (p[i].V[0] * RayDir.V[0] + p[i].V[1] * RayDir.V[1] + p[i].V[2] * RayDir.V[2]);

      r := Vector3D(RayPos.V[0] + t * RayDir.V[0], RayPos.V[1] + t * RayDir.V[1], RayPos.V[2] + t * RayDir.V[2]);

      if (Abs(r.V[0]) <= eSize.V[0]) and (Abs(r.V[1]) <= eSize.V[1]) and (Abs(r.V[2]) <= eSize.V[2]) and
         (Vector3DDotProduct(Vector3DSubtract(r, RayPos), RayDir) > 0) then
      begin
        Intersection := Vector3D(LocalToAbsolute3D(Point3D(r)));
        Result := True;
        Exit;
      end;
    end;
  end;

  Result := False;
end;
{$ENDIF}
{$ENDIF}

procedure TCustomChart3D.ReadState(Reader: TReader);
var tmpChart : TChart;
begin
  tmpChart:=FirstChart;

  if Assigned(tmpChart) and
     (not (csLoading in tmpChart.ComponentState))
     and (not (csAncestor in tmpChart.ComponentState)) then
          FreeAndNil(tmpChart);

  inherited;

  SetupChart(Chart);
end;

{$IFNDEF XE2UPDATE4}
procedure TCustomChart3D.DoMouseEnter;
begin
  inherited;

  if Assigned(FOnMouseEnter) then
     FOnMouseEnter(Self);
end;

procedure TCustomChart3D.DoMouseLeave;
begin
  inherited;

  if Assigned(FOnMouseLeave) then
     FOnMouseLeave(Self);
end;
{$ENDIF}

type
  THackCanvas3D=class(TCanvas3D);

procedure TCustomChart3D.SetChart(const Value:TChart);
var t : Integer;
begin
  Chart.FreeAllSeries;
  Chart.Assign(Value);

  for t:=0 to Value.SeriesCount-1 do
        CloneChartSeries(Value[t]).ParentChart:=Chart;

  for t:=0 to Value.Tools.Count-1 do
        CloneChartTool(Value.Tools[t],Owner).ParentChart:=Chart;
end;

procedure TCustomChart3D.SetFontDepth(const Value: Single);
begin
  FFontDepth := Value;
  Chart.Canvas.Invalidate;
end;

procedure TCustomChart3D.Render;
begin
  if TFMXCanvas3D(Chart.Canvas).FDirty then
     CreateChart;

  inherited;
end;

procedure TCustomChart3D.Resize3D;
begin
  inherited;

  if not (csLoading in ComponentState) then
    (Chart.Canvas as TFMXCanvas3D).FDirty:=True;
end;

const
  InvZFactor=100.0;

procedure TCustomChart3D.CreateChart;
var tmp : TChart;
begin
  tmp:=Chart;

  if THackCanvas3D(tmp.Canvas).Brush=nil then
  begin
    THackCanvas3D(tmp.Canvas).Brush:=TChartBrush.Create;
    THackCanvas3D(tmp.Canvas).Pen:=TChartPen.Create;
    THackCanvas3D(tmp.Canvas).Font:=TTeeFont.Create(nil);
  end;

  with tmp.View3DOptions do
  begin
    ElevationFloat:=Self.RotationAngle.X;
    RotationFloat:=Self.RotationAngle.Y;

    ZoomFloat:=-Self.Position.Z*10;
    HorizOffsetFloat:=Self.Position.X*100;
    VertOffsetFloat:=Self.Position.Y*100;
  end;

  tmp.Width3D:=Round(InvZFactor*Depth);
  TFmxCanvas3D(tmp.Canvas).FontDepth:=FontDepth;

  tmp.Draw(nil, tmp.BoundsRect);

  TFMXCanvas3D(tmp.Canvas).FDirty:=False;

  if Assigned(FOnCreateChart) then
     FOnCreateChart(Self);
end;

{ TFMXCanvas3D }

Constructor TFMXCanvas3D.Create;
begin
  inherited;
  SupportsID:=True;
end;

procedure TFMXCanvas3D.Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX,
  EndY: Integer);
begin
end;

procedure TFMXCanvas3D.Arrow(Filled: Boolean; const FromPoint, ToPoint: TPoint;
  ArrowWidth, ArrowHeight, Z0, Z1: Integer; const ArrowPercent: Double);
begin
end;

type
  TGroup3D=class(TControl3D)
  private
    procedure RecalcPosition;
  public
    Constructor Create(AOwner:TComponent); override;

    {$IFDEF D20}
    function RayCastIntersect(const RayPos, RayDir: TPoint3D; var Intersection: TPoint3D): Boolean; override;
    {$ELSE}
    function RayCastIntersect(const RayPos, RayDir: TVector3D; var Intersection: TVector3D): Boolean; override;
    {$ENDIF}
  end;

function TFMXCanvas3D.BeginEntity(const Entity: String;
  const Visual: TVisualBlock=nil; const Transform:TTeeTransform=nil): TVisualBlock;
var tmp : Integer;
begin
  tmp:=Length(FTree);
  SetLength(FTree, tmp+1);

  FTree[tmp]:=TGroup3D.Create(ItemOwner);

  result:=nil;

  if Assigned(FCurrent) then
  begin
    FTree[tmp].Name:=FCurrent.Name+'_'+Entity;
    FCurrent.AddObject(FTree[tmp]);
  end
  else
  begin
    FTree[tmp].Name:=Entity;
    FVisual.AddObject(FTree[tmp]);
  end;

  FCurrent:=FTree[tmp];
end;

procedure TFMXCanvas3D.Calculate2DPosition(var x, y: Integer; z: Integer);
begin
  x:=0;
  y:=0;
end;

function TFMXCanvas3D.Calculate3DPosition(const x, y, z: Single): TPoint;
begin
  result.X:=x;
  result.Y:=y;
end;

function TFMXCanvas3D.Calculate3DPosition(x, y, z: Integer): TPoint;
begin
  result.X:=x;
  result.Y:=y;
end;

procedure TFMXCanvas3D.ClipCube(const Rect: TRect; MinZ, MaxZ: Integer);
begin
end;

procedure TFMXCanvas3D.ClipRectangle(const Rect: TRect);
begin
  //FCanvas.IntersectClipRect(Rect);
end;

procedure TFMXCanvas3D.Cone(Vertical: Boolean; Left, Top, Right, Bottom, Z0,
  Z1: Integer; Dark3D: Boolean; ConePercent: Integer);
var c : TCone;
    tmpCX,tmpCY,
    tmpX,tmpY : Single;
begin
  c:=TCone.Create(ItemOwner);

  if not Vertical then
  begin
    if Bottom>Top then
       c.RotationAngle.Z:=270
    else
       c.RotationAngle.Z:=90;

    tmpCX:=(Right+Left)*0.5;
    tmpX:=(0.5/IScale.X*IScale.Y)*Abs(Bottom-Top);
    tmpCY:=(Bottom+Top)*0.5;
    tmpY:=Abs(Right-Left)*0.5;
    Prepare(c, tmpCX-tmpX,tmpCY-tmpY,tmpCX+tmpX,tmpCY+tmpY,Z0,Z1);
  end
  else
    Prepare(c,Left,Top,Right,Bottom,Z0,Z1);

  c.SubdivisionsAxes:=TeeNumCylinderSides;

  FCurrent.AddObject(c);
end;

type
  THackVisual=class(TControl3D);

procedure TFMXCanvas3D.Cube(Left, Right, Top, Bottom, Z0, Z1: Integer;
  DarkSides: Boolean=True; RoundSize:Integer=0);
var c : TShape3D;
    tmp : TControl3D;
begin
  if Brush.Kind=TBrushKind.{$IFDEF D20}None{$ELSE}bkNone{$ENDIF} then
  begin
    tmp:=TStrokeCube.Create(ItemOwner);
    PrepareControl3D(tmp,Left,Top,Right,Bottom,Z0,Z1);
    FCurrent.AddObject(tmp);
  end
  else
  begin
    if RoundSize=0 then
       c:=TCube.Create(ItemOwner)
    else
       c:=TRoundCube.Create(ItemOwner);

    Prepare(c,Left,Top,Right,Bottom,Z0,Z1);
    FCurrent.AddObject(c);
  end;
end;

procedure TFMXCanvas3D.Cube(Left, Right, Top, Bottom, Z0, Z1,
  BevelSize: Integer; DarkSides: Boolean=True; RoundSize:Integer=0);
begin
  Cube(Left,Top,Right,Bottom,Z0,Z1,DarkSides,RoundSize);
end;

procedure TFMXCanvas3D.Cylinder(Vertical: Boolean; Left, Top, Right, Bottom, Z0,
  Z1: Integer; Dark3D: Boolean);
var c : TCylinder;
    tmpCX,tmpCY,
    tmpX,tmpY : Single;
begin
  c:=TCylinder.Create(ItemOwner);

  if not Vertical then
  begin
    c.RotationAngle.Z:=90;
    tmpCX:=(Right+Left)*0.5;
    tmpX:=(0.5/IScale.X*IScale.Y)*Abs(Bottom-Top);
    tmpCY:=(Bottom+Top)*0.5;
    tmpY:=Abs(Right-Left)*0.5;
    Prepare(c, tmpCX-tmpX,tmpCY-tmpY,tmpCX+tmpX,tmpCY+tmpY,Z0,Z1);
  end
  else
    Prepare(c,Left,Top,Right,Bottom,Z0,Z1);

  c.SubdivisionsAxes:=TeeNumCylinderSides;

  FCurrent.AddObject(c);
end;

procedure TFMXCanvas3D.Donut(XCenter, YCenter, XRadius, YRadius: Integer;
  const StartAngle, EndAngle, HolePercent: Double);
begin
  // TODO
end;

procedure TFMXCanvas3D.Draw(X, Y: Integer; const Graphic: TGraphic);
begin
  StretchDraw(RectF(X,Y,X+Graphic.Width,Y+Graphic.Height),Graphic);
end;

procedure TFMXCanvas3D.Ellipse(const X1, Y1, X2, Y2: Single);
begin
  EllipseWithZ(X1,Y1,X2,Y2,0);
end;

procedure TFMXCanvas3D.InternalEllipse(const X1, Y1, X2, Y2, Z: Single);
var e : TEllipse3D;
begin
  e:=TEllipse3D.Create(ItemOwner);
  Prepare(e,X1,Y1,X2,Y2,Z,Z);
  FCurrent.AddObject(e);
end;

procedure TFMXCanvas3D.EllipseWithZ(const X1, Y1, X2, Y2: Single; const Z: Integer);
begin
  InternalEllipse(X1,Y1,X2,Y2,Z);
end;

procedure TFMXCanvas3D.EndEntity;
begin
  TGroup3D(FTree[Length(FTree)-1]).RecalcPosition;

  SetLength(FTree,Length(FTree)-1);

  if Length(FTree)>0 then
     FCurrent:=FTree[Length(FTree)-1]
  else
     FCurrent:=nil;

  inherited;
end;

procedure TFMXCanvas3D.EraseBackground(const Rect: TRect);
begin
  InternalRect(Rect, TCustomTeePanel(View3DOptions.Parent).Width3D+1, False, 0);
end;

procedure TFMXCanvas3D.PrepareControl3D(const Shape:TControl3D; const Left,Top,Right,Bottom,Z0,Z1:Single);
begin
  Shape.Position.X:=(((Left+Right)*0.5)-IScale.Width)*IScale.X;
  Shape.Position.Y:=(((Top+Bottom)*0.5)-IScale.Height)*IScale.Y;
  Shape.Position.Z:=(((Z0+Z1)*0.5)-IScale.Depth)*IScale.Z;

  Shape.Width:=Abs(Right-Left)*IScale.X;
  Shape.Height:=Abs(Bottom-Top)*IScale.Y;
  Shape.Depth:=Abs(Z1-Z0)*IScale.Z;
end;

procedure TFMXCanvas3D.Prepare(const Shape:TShape3D; const Left,Top,Right,Bottom,Z0,Z1:Single);
begin
  Shape.Stored:=False; // Disable TabList

  {$IFDEF D22}
  // Bug ?? https://quality.embarcadero.com/browse/RSB-264
  Shape.WrapMode:=TMeshWrapMode.Stretch;
  {$ENDIF}

  PrepareControl3D(Shape,Left,Top,Right,Bottom,Z0,Z1);
  SetMaterialAndName(Shape);
end;

{$IFDEF D17}
type
  TShape3DAccess=class(TShape3D);
  TExtrudedShape3DAccess=class(TExtrudedShape3D);
{$ENDIF}

procedure TFMXCanvas3D.SetMaterialAndName(const AShape:TShape3D);
{$IFDEF D17}
var m : TLightMaterialSource;
{$ENDIF}
begin
  {$IFDEF D17}
  m:=TLightMaterialSource.Create(AShape);
  m.Diffuse:=MakeColor(Brush.Color, Opacity);
  TShape3DAccess(AShape).MaterialSource:=m;
  {$ELSE}
  AShape.Material.Diffuse:=MakeColor(Brush.Color, Opacity);
  {$ENDIF}

  if AShape is TExtrudedShape3D then
  begin
     {$IFDEF D17}
     begin
       m:=TLightMaterialSource.Create(AShape);
       m.Diffuse:=MakeColor(Brush.Color, Opacity);
       TExtrudedShape3DAccess(AShape).MaterialBackSource:=m;
     end;
     {$ELSE}
     TExtrudedShape3D(AShape).MaterialBack.Diffuse:=AShape.Material.Diffuse;
     {$ENDIF}
  end;

  if not Brush.Bitmap.Bitmap.IsEmpty then
     {$IFDEF D17}
     TLightMaterialSource(TShape3DAccess(AShape).MaterialSource).Texture:=Brush.Bitmap.Bitmap;
     {$ELSE}
     AShape.Material.Texture:=Brush.Bitmap.Bitmap;
     {$ENDIF}

  //SetUniqueName(AShape);
end;

{
procedure TFMXCanvas3D.SetUniqueName(const AComp:TComponent);
begin
  AComp.Name:=TeeGetUniqueName(AComp.Owner,Copy(AComp.ClassName,2,Length(AComp.ClassName)));
end;
}

procedure TFMXCanvas3D.InternalRect(const R:TRect; const Z:Single; Border:Boolean; RoundSize:Integer);
var P : TRectangle3D;
begin
  P:=TRectangle3D.Create(ItemOwner);

  {$IFNDEF D18}
  P.XRadius:=RoundSize;
  P.YRadius:=RoundSize;
  {$ENDIF}

  // +0.01 due to HitTest problem when Depth=0
  Prepare(P,R.Left,R.Top,R.Right,R.Bottom, Z, Z+0.01);

  FCurrent.AddObject(P);
end;

procedure TFMXCanvas3D.FillRect(const R: TRect);
begin
  InternalRect(R, 0, False, 0);
end;

function TFMXCanvas3D.GetBackColor: TColor;
begin
  result:=FBackColor;
end;

function TFMXCanvas3D.GetBackMode: TCanvasBackMode;
begin
  result:=FBackMode;
end;

function TFMXCanvas3D.GetIsNoBMPGrid: Boolean;
begin
  result:=True;
end;

function TFMXCanvas3D.GetMonochrome: Boolean;
begin
  result:=FMono;
end;

function TFMXCanvas3D.GetPixel(x, y: Integer): TColor;
begin
  result:=TAlphaColors.White;
end;

function TFMXCanvas3D.GetPixel3D(X, Y, Z: Integer): TColor;
begin
//  result:=Context.BufferBits
  result:=TAlphaColors.White;
end;

function TFMXCanvas3D.GetSupports3DText: Boolean;
begin
  result:=True;
end;

function TFMXCanvas3D.GetSupportsFullRotation: Boolean;
begin
  result:=True;
end;

function TFMXCanvas3D.GetSupportsXORMode: Boolean;
begin
  result:=False; // ?
end;

function TFMXCanvas3D.GetTextAlign: TCanvasTextAlign;
begin
  result:=FTextAlign;
end;

function TFMXCanvas3D.GetUseBuffer: Boolean;
begin
  result:={$IFDEF D17}False {Assigned(Bitmap)} {$ELSE}FVisual.Context.Buffered{$ENDIF};
end;

procedure TFMXCanvas3D.GradientFill(const Rect: TRect; StartColor,
  EndColor: TColor; Direction: TGradientDirection; Balance, RadialX,
  RadialY: Integer);
begin
  Brush.Color:=StartColor;
  InternalRect(Rect,0,False,0);
end;

function TFMXCanvas3D.InitWindow(const DestCanvas: TCanvas;
  const A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;

  procedure FreeAllChildren(const AObject:TFMXObject);
  begin
    {$IFDEF AUTOREFCOUNT}
    while AObject.ChildrenCount>0 do
        FreeAllChildren(AObject.Children[0]);

    AObject.Parent:=nil;
    AObject.DisposeOf;
    {$ELSE}
    AObject.Free;
    {$ENDIF}
  end;

  procedure FreeOurChildren;
  var t : Integer;
  begin
    t:=0;

    while t<FVisual.ChildrenCount do
      if FVisual.Children[t].Owner=ItemOwner then
         FreeAllChildren(FVisual.Children[t])
      else
         Inc(t);
  end;

begin
  FreeOurChildren;

  FBounds:=UserRect;
  F3DOptions:=A3DOptions;

  FontZoom:=F3DOptions.FontZoom;
  IZoomText:=F3DOptions.ZoomText<>ztNo;

  result:=UserRect;
end;

procedure TFMXCanvas3D.Invalidate;
begin
  if not FDirty then
  begin
    FDirty:=True;

    if Assigned(FVisual) then
       FVisual.Repaint;
  end;
end;

procedure TFMXCanvas3D.LineTo(const X, Y: Single);
begin
  LineTo3D(X,Y,0);
end;

procedure TFMXCanvas3D.MoveTo(const X, Y: Single);
begin
  FX:=X;
  FY:=Y;
  FZ:=0;
end;

procedure TFMXCanvas3D.MoveTo3D(const X,Y,Z:TCoordinate);
begin
  FX:=X;
  FY:=Y;
  FZ:=Z;
end;

procedure TFMXCanvas3D.LineTo3D(const X,Y,Z:TCoordinate);
var l : TLine3D;
    tmp1, tmp2 : Single;
begin
  l:=TLine3D.Create(ItemOwner);

  Prepare(l,FX,FY,X,Y,FZ,Z);

  {$IFDEF D17}
  TLightMaterialSource(l.MaterialSource).Diffuse:=MakeColor(Pen.Color, Opacity);
  {$ELSE}
  l.Material.Diffuse:=MakeColor(Pen.Color, Opacity);
  {$ENDIF}

  tmp1:=l.Height*0.5;

  if X>FX then
  begin
    if Y>FY then
       tmp1:=-tmp1;
  end
  else
  if Y<FY then
     tmp1:=-tmp1;

  tmp2:=-tmp1;

  l.FStart:={$IFNDEF D17}FMX.Types3D.{$ENDIF}Point3D(-l.Width*0.5, tmp1, -l.Depth*0.5);
  l.FEnd:={$IFNDEF D17}FMX.Types3D.{$ENDIF}Point3D(l.Width*0.5, tmp2, l.Depth*0.5);

  {$IFDEF D17}
  TLightMaterialSource(l.MaterialSource).Diffuse:=Pen.Color;
  {$ELSE}
  l.Material.Diffuse:=Pen.Color;
  {$ENDIF}

  FCurrent.AddObject(l);

  FX:=X;
  FY:=Y;
  FZ:=Z;
end;

procedure TFMXCanvas3D.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var Theta  : Single;
    Theta2 : Single;
begin
  CalcPieAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4,Theta,Theta2);
  Pie(TeeRect(X1,Y1,X2,Y2),Theta,Theta2);
end;

procedure TFMXCanvas3D.Pie(const R: TRect; const StartAngle, EndAngle: Double);
var s : TSize;
begin
  s:=R.Size.Round;
  Pie3D(Round(R.CenterPoint.X), Round(R.CenterPoint.Y),
        s.cx,s.cy,0,0,StartAngle,EndAngle,True,True);
end;

procedure TFMXCanvas3D.Pie3D(XCenter, YCenter, XRadius, YRadius, Z0,
  Z1: Integer; const StartAngle, EndAngle: Double; DarkSides,
  DrawSides: Boolean; DonutPercent: Integer; Gradient: TCustomTeeGradient;
  BevelPercent: Integer; EdgeStyle: TEdgeStyle; Transparency: TTeeTransparency;
  BevelBright:Integer; BevelBorder:Boolean; HideSides:Boolean);

var p : TPath3D;
    c : TPointF;
begin
  p:=TPath3D.Create(ItemOwner);
  p.WrapMode:=TPathWrapMode.{$IFDEF D20}Original{$ELSE}pwOriginal{$ENDIF};

  Prepare(p,XCenter-XRadius,YCenter+YRadius,XCenter+XRadius,YCenter-YRadius,Z0,Z1);

  c:=PointF(p.Width*0.5,p.Height*0.5);
  p.Path.MoveTo(c);
  p.Path.AddArc(c, PointF(0.5*p.Width,0.5*p.Height), RadToDeg(StartAngle), RadToDeg(EndAngle-StartAngle));
  p.Path.LineTo(c);
  p.Path.ClosePath;

  FCurrent.AddObject(p);
end;

procedure TFMXCanvas3D.Plane3D(const A, B: TPoint; Z0, Z1: Integer);
var m : TMesh;

  procedure SetPoint(out P:TMeshVertex; const X,Y,Z:Single);
  begin
    P.x:=X-0.5;
    P.y:=Y-0.5;
    P.z:=Z-0.5;
  end;

var v : Array[0..3] of TMeshVertex;
begin
  m:=TMesh.Create(ItemOwner);
  m.TwoSide:=True;

  Prepare(m,Min(A.X,B.X),Min(A.Y,B.Y),Max(A.X,B.X),Max(A.Y,B.Y),Z0,Z1);

  if B.Y>A.Y then
  begin
    SetPoint(v[0],0,0,0);
    SetPoint(v[1],1,1,1);
    SetPoint(v[2],1,1,0);
    SetPoint(v[3],0,0,1);
  end
  else
  begin
    SetPoint(v[0],0,1,0);
    SetPoint(v[1],1,0,1);
    SetPoint(v[2],1,0,0);
    SetPoint(v[3],0,1,1);
  end;

  m.Data.AssignFromMeshVertex(v,[0,1,2,0,1,3]);
  m.Data.{$IFDEF D17}CalcFaceNormals{$ELSE}CalcNormals{$ENDIF};
  FCurrent.AddObject(m);
end;

type
  TTeeMesh=class(TCustomMesh)
  end;

procedure TFMXCanvas3D.PlaneFour3D(var Points: TFourPoints; Z0, Z1: Integer);

  function CalcPoint(const P,Z:Integer):TPoint3D;
  begin
    result:={$IFDEF D20}{$ELSE}{$IFDEF D17}System.Types.{$ELSE}FMX.Types3D.{$ENDIF}{$ENDIF}Point3D((Points[P].X-IScale.Width)*IScale.X,
                    (Points[P].Y-IScale.Height)*IScale.Y,
                    (Z-IScale.Depth)*IScale.Z)
  end;

var m : TTeeMesh;
//    miny, maxy : Single;
begin
  m:=TTeeMesh.Create(ItemOwner);

  with m.Data do
  begin
    VertexBuffer.Length:=4;
    IndexBuffer.Length:=6;
  end;

  with m.Data.VertexBuffer do
  begin
    Vertices[0]:=CalcPoint(0,Z0);
    Vertices[1]:=CalcPoint(1,Z0);
    Vertices[2]:=CalcPoint(2,Z1);
    Vertices[3]:=CalcPoint(3,Z1);
  end;

  with m.Data.IndexBuffer do
  begin
    Indices[0]:=0;
    Indices[1]:=1;
    Indices[2]:=2;
    Indices[3]:=2;
    Indices[4]:=3;
    Indices[5]:=0;
  end;

  //miny:=Min(Points[0].Y,Min(Points[1].Y,Min(Points[2].Y,Points[3].Y)))*IScale.Y;
  //maxy:=Max(Points[0].Y,Max(Points[1].Y,Max(Points[2].Y,Points[3].Y)))*IScale.Y;

  SetMaterialAndName(m);
  //Prepare(m,Points[0].X,miny,Points[1].X,maxy,z0,z1);

  with m.Data.VertexBuffer do
  begin
    TexCoord0[0] := PointF(0,0);
    TexCoord0[1] := PointF(1,0);
    TexCoord0[2] := PointF(1,1);
    TexCoord0[3] := PointF(0,1);
  end;

  m.Data.{$IFDEF D17}CalcFaceNormals{$ELSE}CalcNormals{$ENDIF};
  m.TwoSide:=True;

  FCurrent.AddObject(m);
end;

procedure TFMXCanvas3D.PlaneWithZ(P1, P2, P3, P4: TPoint; Z: Integer);
begin
  PolygonWithZ([P1,P2,P3,P4],Z);
end;

type
  TPolygon3D = class(TExtrudedShape3D)
  protected
    procedure Render; override;
  public
    Points : Array of TPoint;
    Destructor Destroy; override;
  end;

procedure TFMXCanvas3D.PolygonWithZ(const Points:Array of TPoint; Z:Integer);
var m : TPolygon3D;
    t : Integer;
    r : TRect;
    c : TPointF;
    tmpW,
    tmpH : Single;
begin
  m:=TPolygon3D.Create(ItemOwner);

  r:=PolygonBounds(Points);
  c:=r.CenterPoint;

  tmpW:=1/(r.Width*2);
  tmpH:=1/(r.Height*2);

  // To avoid "Floating point div by zero" at TExtrudedShape3D.MouseMove3D,
  // z Depth is forced to a minimum of "0.01"

  with r do
    Prepare(m,Left,Top,Right,Bottom,Z-0.01,Z);

  SetLength(m.Points,Length(Points));
  for t:=0 to High(Points) do
  begin
    m.Points[t].X:=(Points[t].X-c.X)*tmpW;
    m.Points[t].Y:=(Points[t].Y-c.Y)*tmpH;
  end;

  FCurrent.AddObject(m);
end;

procedure TFMXCanvas3D.Polygon(const Points: array of TPoint);
begin
  PolygonWithZ(Points,0);
end;

procedure TFMXCanvas3D.Polygon3D(const Points: array of {$IFDEF FMX}FMXTee.Canvas.{$ENDIF}TPoint3D);
begin
  // TPathData3D ?
end;

procedure TFMXCanvas3D.Polyline(const Points: Array of TPoint);
begin
end;

procedure TFMXCanvas3D.Projection(MaxDepth: Integer; const ABounds,
  Rect: TRect);
begin
  if Bounds.Width=0 then
     IScale.X:=1
  else
     IScale.X:=FVisual.Width/Bounds.Width;

  if Bounds.Height<>0 then
     IScale.Y:=FVisual.Height/Bounds.Height;

  if MaxDepth=0 then
     IScale.Z:=1
  else
     IScale.Z:=FVisual.Depth/MaxDepth;

  IScale.Width:=Bounds.Width*0.5;
  IScale.Height:=Bounds.Height*0.5;
  IScale.Depth:=MaxDepth*0.5;
end;

procedure TFMXCanvas3D.Pyramid(Vertical: Boolean; Left, Top, Right, Bottom, z0,
  z1: Integer; DarkSides: Boolean);
begin
  Cone(Vertical,Left,Top,Right,Bottom,Z0,Z1,DarkSides,0);
end;

procedure TFMXCanvas3D.PyramidTrunc(const R: TRectF; const StartZ, EndZ, TruncX,
  TruncZ: Double; TopCover:Boolean=True; BottomCover:Boolean=True);
var z0,
    z1 : Integer;
begin
  z0:=Round(StartZ);
  z1:=Round(EndZ);

  // Pending: Truncation
  with R.Round do
       Cone(True,Left,Top,Right,Bottom,z0,z1,True,0);
end;

procedure TFMXCanvas3D.Rectangle(const X0, Y0, X1, Y1: Single);
begin
  InternalRect(RectF(X0,Y0,X1,Y1), 0, True, 0);
end;

procedure TFMXCanvas3D.RectangleWithZ(const Rect: TRect; Z: Integer);
begin
  InternalRect(Rect, Z, True, 0);
end;

procedure TFMXCanvas3D.RectangleY(const Left, Top, Right: Single; const Z0,
  Z1: Integer);
var c : TCube;
begin
  c:=TCube.Create(ItemOwner);
  Prepare(c,Left,Top,Right,Top+1,Z0,Z1);
  FCurrent.AddObject(c);
end;

procedure TFMXCanvas3D.RectangleZ(const Left, Top, Bottom: Single; const Z0,
  Z1: Integer);
var c : TCube;
begin
  c:=TCube.Create(ItemOwner);
  Prepare(c,Left,Top,Left+1,Bottom,Z0,Z1);
  FCurrent.AddObject(c);
end;

function TFMXCanvas3D.ReDrawBitmap: Boolean;
begin
  result:=False;
end;

function TFMXCanvas3D.RenderToBitmap(var ABitmap:TBitmap; const R:TRect):Boolean;
begin
  FVisual.PaintToBitmap(ABitmap,ABitmap.Width,ABitmap.Height,claWhite
      {$IFDEF D161}False,TMultiSample.ms4Samples{$ENDIF});
  result:=True;
end;

procedure TFMXCanvas3D.RotateLabel(x, y: Integer; const St: String;
                                   RotDegree: Double; AllowHTML:Boolean=False);
begin
  RotateLabel3D(x,y,0,St,RotDegree,AllowHTML);
end;

procedure TFMXCanvas3D.RotateLabel3D(x, y, z: Integer; const St: String;
                                     RotDegree: Double; AllowHTML:Boolean=False);
begin
  TextOut3D(x,y,z,St,AllowHTML);
end;

procedure TFMXCanvas3D.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  InternalRect(RectF(X1,Y1,X2,Y2), 0, True, X3);
end;

procedure TFMXCanvas3D.SetBackColor(const Value: TColor);
begin
  FBackColor:=Value;
end;

procedure TFMXCanvas3D.SetBackMode(const Value: TCanvasBackMode);
begin
  FBackMode:=Value;
end;

procedure TFMXCanvas3D.SetFastLine(const Active: Boolean);
begin
end;

procedure TFMXCanvas3D.SetMonochrome(Value: Boolean);
begin
  FMono:=Value;
end;

procedure TFMXCanvas3D.SetPixel(X, Y: Integer; Value: TColor);
begin
end;

procedure TFMXCanvas3D.SetPixel3D(X, Y, Z: Integer; Value: TColor);
begin
end;

procedure TFMXCanvas3D.SetTextAlign(const Value: TCanvasTextAlign);
begin
  FTextAlign:=Value;
end;

procedure TFMXCanvas3D.SetUseBuffer(Value: Boolean);
begin  // Not necessary
end;

procedure TFMXCanvas3D.ShowImage(const DestCanvas, DefaultCanvas: TCanvas;
  const UserRect: TRect);
begin  // Not necessary
end;

procedure TFMXCanvas3D.SmoothShadow(const Shadow: TTeeShadow; const Rect: TRect;
  Ellipse: Boolean; RoundSize: Integer; const P: array of TPoint;
  DonutPercent: Integer; const StartAngle: Double; const EndAngle:Double);
var tmpZ : Double;
begin
  Brush.Color:=Shadow.Color;
  Brush.Style:=bsSolid;

  if Pen.Style<>psClear then
  begin
    Pen.Style:=psSolid;
    Pen.Color:=Brush.Color;
  end;

  if (View3DOptions.Parent is TCustomTeePanel) and (not TCustomTeePanel(View3DOptions.Parent).View3D) then
     tmpZ:=0
  else
     tmpZ:=Shadow.ZPosition;

  if Length(P)>0 then
     PolygonWithZ(P,Round(tmpZ)) // TODO: Z:Single
  else
  if Ellipse then
     InternalEllipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, tmpZ)
  else
     InternalRect(Rect,tmpZ+0.1,False,RoundSize);
end;

procedure TFMXCanvas3D.Sphere(x, y, z: Integer; const Radius: Double);
var s : TSphere;
begin
  s:=TSphere.Create(ItemOwner);
  Prepare(s,x-Radius,y-Radius,x+Radius,y+Radius,z-Radius,z+Radius);
  s.SubdivisionsAxes:=TeeNumCylinderSides;
  FCurrent.AddObject(s);
end;

procedure TFMXCanvas3D.StretchDraw(const Rect: TRect; const Graphic: TGraphic);
var i : TImage3D;
begin
  i:=TImage3D.Create(ItemOwner);
  i.Bitmap.Assign(Graphic);

  i.Position.X:=Rect.Left;
  i.Position.Y:=Rect.Top;
  i.Position.Z:=0;

  i.Width:=Rect.Width;
  i.Height:=Rect.Height;
  i.Depth:=0.01;

  //SetUniqueName(i);
  FCurrent.AddObject(i);
end;

{
type
  TFMXCached=class(TTeeCachedObject)
  private
    Mesh : TMesh;
  end;
}

procedure TFMXCanvas3D.Surface3D( Style:TTeeCanvasSurfaceStyle;
                                  SameBrush,CreateCached,AddNormals:Boolean;
                                  NumXValues,NumZValues:Integer;
                                  const CalcPoints:TTeeCanvasCalcPoints;
                                  var Cached:TTeeCachedObject);

var m : TMesh;

  Procedure DrawCells;
  var V,
      I,
      tmpX,
      tmpZ : Integer;

    Procedure AddVertexs;
    var Vertex : TSurfaceVertex;
    begin
      CalcPoints(tmpX,tmpZ+1,not SameBrush,Vertex);

      if Vertex.Flag then
      begin
        with m.Data.VertexBuffer do
        begin
          Vertices[V]:={$IFDEF D20}{$ELSE}{$IFDEF D17}System.Types{$ELSE}FMX.Types3D{$ENDIF}.{$ENDIF}Point3D(Vertex.P0.X,Vertex.P0.Y,Vertex.P0.Z);
          Vertices[V+1]:={$IFDEF D20}{$ELSE}{$IFDEF D17}System.Types{$ELSE}FMX.Types3D{$ENDIF}.{$ENDIF}Point3D(Vertex.P1.X,Vertex.P1.Y,Vertex.P1.Z);
        end;

        with m.Data do
        begin
          IndexBuffer[I] := V+1;
          IndexBuffer[I+1] := V+2;
          IndexBuffer[I+2] := V+3;
          IndexBuffer[I+3] := V+3;
          IndexBuffer[I+4] := V+0;
          IndexBuffer[I+5] := V+1;
        end;

        Inc(V,2);
        Inc(I,6);

        {
        if SameBrush then
        begin
          With P0 do TeeVertex3D(x,y,z);
          With P1 do TeeVertex3D(x,y,z);
        end
        else
        begin
          if tmpColor0<>clNone then SetColor(tmpColor0);
          With P0 do TeeVertex3D(x,y,z);
          if tmpColor1<>clNone then SetColor(tmpColor1);
          With P1 do TeeVertex3D(x,y,z);
        end;
        }
      end
      else
      begin
        {
        glEnd;
        glBegin(GL_QUAD_STRIP);
        TeeNormal(0,-1,0);
        }
      end;
    end;

  begin
    V:=0;
    I:=0;

    for tmpX:=2 to NumXValues do
        for tmpZ:=NumZValues-1 downto 0 do
            AddVertexs;
  end;

begin
  m:=TMesh.Create(ItemOwner);
  FCurrent.AddObject(m);

  {
  if CreateCached then
  begin
    Cached:=TFMXCached.Create;
    TFMXCached(Cached).Mesh:=m;
  end;
  }

  m.Data.VertexBuffer.Length:=(NumXValues*NumZValues);
  m.Data.IndexBuffer.Length:=6*(Pred(NumXValues)*Pred(NumZValues));

  DrawCells;

  {
  if (Pen.Style<>psClear) and (Style=tcsSolid) then
  begin
    glPolygonMode(TeeColorPlanes,GL_LINE);
    SetColor(Pen.Color);
    SameBrush:=True;
    DrawCells;
  end;
  }
end;

function TFMXCanvas3D.TextHeight(const St: String): Integer;
begin
  result:=Round(FCanvas.TextHeight(St));
end;

procedure TFMXCanvas3D.TextOut(const X, Y: Single; const Text: String);
begin
  InternalTextOut(X,Y,0,Text,True);
end;

procedure TFMXCanvas3D.TextOut3D(x, y, z: Integer; const Text: String;
   AllowHTML: Boolean=False);
begin
  InternalTextOut(x,y,z,Text,AllowHtml);
end;

procedure TFMXCanvas3D.InternalTextOut(const x, y, z: Single; const Text: String;
  AllowHTML: boolean);
var t : TText3D;
    tmpX, tmpY,
    tmpW, tmpH : Single;
begin
  t:=TText3D.Create(ItemOwner);

  //t.DesignInteract:=False;
  t.DesignLocked:=True;

  t.WordWrap:=False;
  t.Stretch:=True;
  t.Text:=Text;
  t.Font:=Font;

  // QC112375
  t.Sides:=[TExtrudedShapeSide.{$IFDEF D20}Front{$ELSE}esFront{$ENDIF}]; //, TExtrudedShapeSide.esBack];

  if IZoomText and (FontZoom<>100) then
     t.Font.Size:=t.Font.Size*Max(1,FontZoom)*0.01;

  tmpW:=FCanvas.TextWidth(Text);
  tmpH:=FCanvas.TextHeight(Text);

  if TextAlign=TA_LEFT then
     tmpX:=x
  else
  if TextAlign=TA_RIGHT then
     tmpX:=x-tmpW
  else
     tmpX:=x-(tmpW*0.5);

  tmpY:=y;

  Brush.Color:=Font.Color;

  // To avoid "Floating point div by zero" at TExtrudedShape3D.MouseMove3D,
  // z Depth is forced to a minimum of "0.01"
  Prepare(t,tmpX,tmpY+tmpH*0.25,tmpX+tmpW,tmpY+tmpH*0.75,z-FontDepth-0.01,z);

  FCurrent.AddObject(t);

  {$IFDEF D18}
  // QC116436:
  t.Stretch:=False;
  t.Stretch:=True;
  {$ENDIF}
end;

function TFMXCanvas3D.TextWidth(const St: String): Integer;
begin
  result:=Round(FCanvas.TextWidth(St));
end;

procedure TFMXCanvas3D.Triangle3D(const Points: TTrianglePoints3D;
  const Colors: TTriangleColors3D);
begin
end;

procedure TFMXCanvas3D.TriangleWithZ(const P1, P2, P3: TPoint; Z: Integer);
begin
  PolygonWithZ([P1,P2,P3],Z);
end;

procedure TFMXCanvas3D.UnClipRectangle;
begin
  //FCanvas.ResetClipRect;
end;

{ TPolygon3D }

destructor TPolygon3D.Destroy;
begin
  Points:=nil;
  inherited;
end;

procedure TPolygon3D.Render;
var
  t : Integer;
  S: TPoint;
  VP: TPolygon;
  r: TRect;
  Path: TPathData;

  tmpCenter,
  tmpSize : {$IFDEF D20}TPoint3D{$ELSE}TVector3D{$ENDIF};

  tmpZeroR : TRectF;
begin
  inherited;

  if Length(Points)>0 then
  begin
    Path := TPathData.Create;
    try
      Path.MoveTo(Points[0]);

      for t:=0 to Length(Points)-1 do
          Path.LineTo(Points[t]);

      {$IFNDEF D19}
      Path.MoveTo(Points[0]);
      {$ENDIF}

      Path.ClosePath;

      S := Path.FlattenToPolygon(VP, Flatness);

      if (S.X > 0) and (S.Y > 0) then
      begin
        r := RectF(0, 0, Width, Height);

        tmpCenter:={$IFDEF D20}Point3D{$ELSE}Vector3D{$ENDIF}(Width * 0.5, Height * 0.5, 0);
        tmpSize:={$IFDEF D20}Point3D{$ELSE}Vector3D{$ENDIF}(RectWidth(r), RectHeight(r), Depth);

        tmpZeroR:=RectF(0, 0, 0, 0);

        { front }
        if TExtrudedShapeSide.{$IFDEF D20}Front{$ELSE}esFront{$ENDIF} in Sides then
        begin
          Context.FillPolygon(tmpCenter, tmpSize, tmpZeroR, VP,
            {$IFDEF D17}
            TMaterialSource.ValidMaterial(MaterialSource),
            {$ENDIF}
            AbsoluteOpacity, true, false, false);
        end;
        { back }
        if TExtrudedShapeSide.{$IFDEF D20}Back{$ELSE}esBack{$ENDIF} in Sides then
        begin
          {$IFNDEF D17}
          Context.SetMaterial(MaterialBack);
          {$ENDIF}
          Context.FillPolygon(tmpCenter, tmpSize, tmpZeroR, VP,
            {$IFDEF D17}
            TMaterialSource.ValidMaterial(MaterialBackSource),
            {$ENDIF}
            AbsoluteOpacity, false, true, false);
        end;
        { shaft }
        if TExtrudedShapeSide.{$IFDEF D20}Shaft{$ELSE}esShaft{$ENDIF} in Sides then
        begin
          {$IFNDEF D17}
          Context.SetMaterial(MaterialShaft);
          {$ENDIF}
          Context.FillPolygon(tmpCenter, tmpSize, tmpZeroR, VP,
            {$IFDEF D17}
            TMaterialSource.ValidMaterial(MaterialShaftSource),
            {$ENDIF}
            AbsoluteOpacity, false, false, true);
        end;
      end;

    finally
      Path.Free;
    end;
  end;
end;

{ TLine3D }

{$IFDEF D20}
function TLine3D.RayCastIntersect(const RayPos, RayDir: TPoint3D;
  var Intersection: TPoint3D): Boolean;
{$ELSE}
function TLine3D.RayCastIntersect(const RayPos, RayDir: TVector3D;
  var Intersection: TVector3D): Boolean;
{$ENDIF}
begin
  inherited RayCastIntersect(RayPos,RayDir,Intersection);
  Result := False;
end;

procedure TLine3D.Render;
begin
  inherited;

  {$IFDEF D17}
  Context.DrawLine({$IFDEF D20}Point3D{$ELSE}Vector3D{$ENDIF}(FStart.X,FStart.Y,FStart.Z),
                   {$IFDEF D20}Point3D{$ELSE}Vector3D{$ENDIF}(FEnd.X,FEnd.Y,FEnd.Z),
                   AbsoluteOpacity,
                   TLightMaterialSource(MaterialSource).Diffuse);
  {$ELSE}
  Context.SetColor(TMaterialColor.mcDiffuse, Material.Diffuse);
  Context.DrawLine(Vector3D(FStart.X,FStart.Y,FStart.Z),
                   Vector3D(FEnd.X,FEnd.Y,FEnd.Z),AbsoluteOpacity);
  {$ENDIF}
end;

procedure TLine3D.SetEnd(const Value: {$IFNDEF D17}FMX.Types3D.{$ENDIF}TPoint3D);
begin
  FEnd:=Value;
  Repaint;
end;

procedure TLine3D.SetStart(const Value: {$IFNDEF D17}FMX.Types3D.{$ENDIF}TPoint3D);
begin
  FStart:=Value;
  Repaint;
end;

{ TGroup3D }

constructor TGroup3D.Create(AOwner: TComponent);
begin
  inherited;
  Stored:=False;

  // SetSize(0,0,0);
  // Faster:
  FWidth:=0;
  FHeight:=0;
  FDepth:=0;
end;

{$IFDEF D20}
function TGroup3D.RayCastIntersect(const RayPos, RayDir: TPoint3D;
  var Intersection: TPoint3D): Boolean;
{$ELSE}
function TGroup3D.RayCastIntersect(const RayPos, RayDir: TVector3D;
  var Intersection: TVector3D): Boolean;
{$ENDIF}
begin
  // Size (Width,Height,Depth) is zero, so skip intersect test:
  //inherited RayCastIntersect(RayPos,RayDir,Intersection);
  result:=False;
end;

procedure TGroup3D.RecalcPosition;
var t : Integer;
    tmp : Integer;
    InvTmp : Single;
    tmpC : TControl3D;
begin
  Position.X:=0;
  Position.Y:=0;
  Position.Z:=0;

  tmp:=0;

  for t := 0 to ChildrenCount-1 do
  if Children[t] is TControl3D then
  begin
    Inc(tmp);
    tmpC:=TControl3D(Children[t]);
    Position.X:=Position.X+tmpC.Position.X;
    Position.Y:=Position.Y+tmpC.Position.Y;
    Position.Z:=Position.Z+tmpC.Position.Z;
  end;

  if tmp>0 then
  begin
    InvTmp:=1/tmp;
    Position.X:=Position.X*InvTmp;
    Position.Y:=Position.Y*InvTmp;
    Position.Z:=Position.Z*InvTmp;
  end;

  for t := 0 to ChildrenCount-1 do
  if Children[t] is TControl3D then
  begin
    tmpC:=TControl3D(Children[t]);
    tmpC.Position.X:=tmpC.Position.X-Position.X;
    tmpC.Position.Y:=tmpC.Position.Y-Position.Y;
    tmpC.Position.Z:=tmpC.Position.Z-Position.Z;
  end;
end;

initialization
  TeeRenderClasses.Add(TFMXCanvas3D);
  RegisterFmxClasses([TChart,TPolygon3D,TLine3D,TGroup3D]);
end.
