{**********************************************}
{   TeeChart VRML 3D related functions         }
{   Copyright (c) 2007-2020 by Steema Software }
{**********************************************}
unit TeeVRML3D;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,

  {$IFDEF D17}
  System.UITypes,
  {$ENDIF}

  Graphics, Controls, Forms, Dialogs, StdCtrls,

  {$IFDEF D6}
  Types,
  {$ENDIF}

  TeCanvas, TeeProcs, TeeExport;

type
  TVRMLOptions = class(TForm)
    LabelWWW: TLabel;
    BRun: TButton;
    procedure LabelWWWClick(Sender: TObject);
    procedure BRunClick(Sender: TObject);
  private
    { Private declarations }
    Panel : TCustomTeePanel;
  public
    { Public declarations }
  end;

  TVRML3DCanvas=class(TTeeNeutralCanvas)
  private
    FX : Integer;
    FY : Integer;
    FZ : Integer;

    IClosedLine: Boolean;
    IStrings   : TStrings;

    function ABCToString(const A,B,C:Double):String;
    procedure AddAppearance; overload;
    procedure AddAppearance(AColor:TColor); overload;
    procedure AddTransform(X,Y,Z:Integer);
    function AllPoints(const Points: Array of TPoint; Z:Integer):String; overload;
    function AllPoints(const Points: Array of TPoint3D):String; overload;
    function AllPoints(const Rect:TRect; Z:Integer):String; overload;
    function AllPoints(const Points: Array of TPoint3DFloat):String; overload;
    procedure EndTransform;
    function Indexes(Max:Integer):String;
    Procedure InternalPolygon3D(const Points: String; ALength:Integer);
    Procedure Polygon3DFloat(const Points: Array of TPoint3DFloat);
    function VRMLColor(AColor:TColor):String;
    function XYZ(const X,Y,Z:Double):String;
  protected
    function BeginEntity(const Entity:String; const Visual:TVisualBlock=nil; const Transform:TTeeTransform=nil):TVisualBlock; override;
    procedure EndEntity; override;

    Function GetHandle:TTeeCanvasHandle; override;
    Function GetIsNoBMPGrid:Boolean; override;
    Function GetPixel(x,y:Integer):TColor; override;
    Function GetPixel3D(X,Y,Z:Integer):TColor; override;
    Function GetSupports3DText:Boolean; override;
    Function GetSupportsFullRotation:Boolean; override;
    Function GetSupportsXORMode:Boolean; override;
    Function GetUseBuffer:Boolean; override;

    procedure SetPixel(X, Y: Integer; Value: TColor); override;
    procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;
    Procedure SetUseBuffer(Value:Boolean); override;
  public
    Constructor CreateText(Panel:TCustomTeePanel; AStrings:TStrings);
    Destructor Destroy; override;

    class function Description:String; override;

    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;
    Function ReDrawBitmap:Boolean; override;
    Procedure ShowImage(const DestCanvas,DefaultCanvas:TCanvas;
                        Const UserRect:TRect); override;

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

    procedure ClipRectangle(Const Rect:TRect); override;
    procedure UnClipRectangle; override;

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY,
                  EndX, EndY: Integer); override;

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

    procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                    Dark3D:Boolean; ConePercent:Integer); override;

    procedure Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,
                       Z0,Z1:Integer; Dark3D:Boolean=True); override;

    Procedure Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean=True;
                   RoundSize:Integer=0); override;
    Procedure Cube(Left,Right,Top,Bottom,Z0,Z1,BevelSize:Integer;
                   DarkSides:Boolean=True; RoundSize:Integer=0); 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: Integer); override;
    procedure EllipseWithZ(const X1, Y1, X2, Y2, Z: Integer); override;
    procedure EraseBackground(const Rect: TRect); override;
    procedure FillRect(const Rect: TRect); override;
    Procedure GradientFill( Const Rect:TRect;
                               StartColor,EndColor:TColor;
                               Direction:TGradientDirection;
                               Balance:Integer=50;
                               RadialX:Integer=0;
                               RadialY:Integer=0); override;
    Procedure Invalidate; override;
    procedure LineTo(const X, Y: Integer); override;
    procedure LineTo3D(const X,Y,Z:Integer); override;
    procedure MoveTo(const X,Y:Integer); override;
    procedure MoveTo3D(const X,Y,Z:Integer); override;

    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Pie(const R:TRect; const StartAngle,EndAngle:Double); 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 PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); override;
    procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); override;
    Procedure Polygon({$IFDEF D6}const{$ENDIF} Points: Array of TPoint); override;
    Procedure Polygon3D(const Points: Array of TPoint3D); overload; override;
    procedure PolygonWithZ(const Points: Array of TPoint; Z:Integer); override;
    Procedure Polyline({$IFDEF D6}const{$ENDIF} Points:Array of TPoint); override;
    procedure Polyline(const Points:Array of TPoint; Z:Integer); overload; override;
    Procedure Polyline(const Points:Array of TPoint3D); overload;
    Procedure Polyline(const Points:Array of TPoint3DFloat); overload;
    procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
                       DarkSides:Boolean=True); override;
    //Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
    //                       TruncX,TruncZ:Integer); override;
    procedure Rectangle(const X0,Y0,X1,Y1:Integer); override;
    Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); override;
    Procedure RectangleY(const Left,Top,Right,Z0,Z1:Integer); override;
    Procedure RectangleZ(const Left,Top,Bottom,Z0,Z1:Integer); override;
    procedure RotateLabel(x,y:Integer; const St:String; RotDegree:Double; AllowHTML:Boolean=False); override;
    procedure RotateLabel3D(x,y,z:Integer; const St:String; RotDegree:Double; AllowHTML:Boolean=False); override;
    procedure RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer); override;
    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 StretchDraw(const Rect: TRect; const Graphic: TGraphic); override;
    Procedure TextOut(X,Y:Integer; const Text:String); override;
    Procedure TextOut3D(X,Y,Z:Integer; const Text:String; AllowHTML:Boolean=False); override;
    procedure Triangle3D( Const Points:TTrianglePoints3D;
                          Const Colors:TTriangleColors3D); override;
    procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); override;
  end;

  TVRMLExportFormat=class(TTeeExportFormat)
  private
    Procedure CheckProperties;
  protected
    FProperties : TVRMLOptions;
    Procedure DoCopyToClipboard; override;
  public
    Destructor Destroy; override;

    function Description:String; override;
    function FileExtension:String; override;
    class function FileFilter:String; override;
    Function VRML:TStringList;
    Function Options(Check:Boolean=True):TForm; override;
    Procedure SaveToStream(Stream:TStream); override;
  end;

procedure TeeSaveToVRML(APanel:TCustomTeePanel; const FileName:WideString);

implementation

{$IFNDEF LCL}
{$R *.DFM}
{$ELSE}
{$R *.lfm}
{$ENDIF}

uses
  Clipbrd, TeeConst, Math;

procedure TVRMLOptions.LabelWWWClick(Sender: TObject);
begin
  TeeGotoURL(Handle,LabelWWW.Caption);
end;

{ TVRMLExportFormat }

Destructor TVRMLExportFormat.Destroy;
begin
  inherited;
end;

procedure TVRMLExportFormat.CheckProperties;
begin
  if not Assigned(FProperties) then
  begin
    FProperties:=TVRMLOptions.Create(nil);
    FProperties.Panel:=Panel;
  end;
end;

const
  TeeMsg_AsVRML='as &VRML 3D';
  TeeMsg_VRMLFilter='VRML 3D files (*.wrl)|*.wrl';

function TVRMLExportFormat.Description: String;
begin
  result:=TeeMsg_AsVRML;
end;

procedure TVRMLExportFormat.DoCopyToClipboard;
begin
  with VRML do
  try
    TeeCopyClipboard(Text);
  finally
    Free;
  end;
end;

function TVRMLExportFormat.FileExtension: String;
begin
  result:='wrl'; // Do not localize
end;

class function TVRMLExportFormat.FileFilter: String;
begin
  result:=TeeMsg_VRMLFilter;
end;

function TVRMLExportFormat.Options(Check: Boolean): TForm;
begin
  if Check then CheckProperties;
  result:=FProperties;
end;

procedure TVRMLExportFormat.SaveToStream(Stream: TStream);
begin
  with VRML do
  try
    SaveToStream(Stream);
  finally
    Free;
  end;
end;

type
  TTeePanelAccess=class(TCustomTeePanel);

function TVRMLExportFormat.VRML: TStringList;
var tmp : TCanvas3D;
begin
  result:=TStringList.Create;

  Panel.AutoRepaint:=False;
  try
    tmp:=TTeePanelAccess(Panel).InternalCanvas;
    TTeePanelAccess(Panel).InternalCanvas:=nil;

    try
      Panel.Canvas:=TVRML3DCanvas.CreateText(Panel,result);

      if not Assigned(Panel.Parent) then
         Panel.BufferedDisplay:=True;

      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(Width,Height));
    finally
      Panel.Canvas:=tmp;
    end;
  finally
    Panel.AutoRepaint:=True;
  end;
end;

procedure TeeSaveToVRML(APanel:TCustomTeePanel; const FileName:WideString);
begin
  with TVRMLExportFormat.Create do
  try
    Panel:=APanel;
    SaveToFile(FileName);
  finally
    Free;
  end;
end;

{ TVRML3DCanvas }

type
  TControlAccess=class(TControl);

function TVRML3DCanvas.InitWindow(const DestCanvas: TCanvas;
  const A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;
var tmp : TControl;
begin
  // abstract: inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);
  FBounds:=UserRect;
  F3DOptions:=A3DOptions;

  if Assigned(F3DOptions) then
  begin
    FontZoom:=F3DOptions.FontZoom;
    FIsOrthogonal:=F3DOptions.Orthogonal;
  end
  else
  begin
    FIsOrthogonal:=False;
    FontZoom:=100;
  end;


  SetCanvas(DestCanvas);
  result:=UserRect;

  IStrings.Add('#VRML V2.0 utf8');

  IStrings.Add('WorldInfo {');
  IStrings.Add('  title "'+View3DOptions.Parent.Name+'"');
  IStrings.Add('  info [ "'+TeeMsg_Copyright+'",');
  IStrings.Add('         "'+TeeMsg_Version+'" ] ');
  IStrings.Add('}');
  IStrings.Add('');
  IStrings.Add('Background {');

  tmp:=TControl(View3DOptions.Parent);

  IStrings.Add('  skyColor [ '+VRMLColor(TControlAccess(tmp).Color)+' ]');
  IStrings.Add('}');

//  IStrings.Add('DirectionalLight { direction 1 0 0 }');
//  IStrings.Add('SpotLight { direction 1 0 0 }');
//  IStrings.Add('PointLight { direction 1 0 0 }');

//  IStrings.Add('Viewpoint { fieldOfView 0.5 }');

  AddTransform(0,0,0);
end;

Procedure TVRML3DCanvas.Projection(MaxDepth:Integer; const ABounds,Rect:TRect);
begin
  // Do nothing.
end;

Function TVRML3DCanvas.ReDrawBitmap:Boolean;
begin
  result:=True;
end;

Procedure TVRML3DCanvas.ShowImage(const DestCanvas,DefaultCanvas:TCanvas;
                        Const UserRect:TRect);
begin
  IStrings.Add('  ]');
  IStrings.Add('}');
end;

function TVRML3DCanvas.BeginEntity(const Entity: String; const Visual:TVisualBlock=nil; const Transform:TTeeTransform=nil):TVisualBlock;
begin
  result:=inherited BeginEntity(Entity,Visual,Transform);
end;

Constructor TVRML3DCanvas.CreateText(Panel: TCustomTeePanel; AStrings: TStrings);
begin
  Create;
  IStrings:=AStrings;

  FSupportsAlpha:=True;
end;

procedure TVRML3DCanvas.Cube(Left, Right, Top, Bottom, Z0, Z1,
           BevelSize: Integer; DarkSides: Boolean=True;
           RoundSize:Integer=0);
begin
  {$IFDEF D6}
  inherited;
  {$ELSE}
  Cube(Left,Right,Top,Bottom,Z0,Z1,DarkSides,RoundSize);
  {$ENDIF}
end;

Destructor TVRML3DCanvas.Destroy;
begin
  inherited;
end;

class function TVRML3DCanvas.Description:String;
begin
  result:='VRML 3D';
end;

function TVRML3DCanvas.ABCToString(const A,B,C:Double):String;
begin
  result:=FormatFloat('0.##',A)+' '+FormatFloat('0.##',B)+' '+FormatFloat('0.##',C);
end;

function TVRML3DCanvas.XYZ(const X,Y,Z:Double):String;
begin
  result:=ABCToString(X/300,-Y/300,-Z/300);
end;

procedure TVRML3DCanvas.AddTransform(X,Y,Z:Integer);
begin
  IStrings.Add('      Transform {');

  if (X<>0) or (Y<>0) or (Z<>0) then
     IStrings.Add('        translation '+XYZ(X,Y,Z));

  IStrings.Add('        children [');
end;

function TVRML3DCanvas.VRMLColor(AColor:TColor):String;
const
  Inv255 = 1/255;
begin
  //AColor:=ColorToRGB(AColor);

  AColor:=TTeeCanvas.ColorFrom(AColor,0);

  result:=ABCToString(GetRValue(AColor)*Inv255,
                      GetGValue(AColor)*Inv255,
                      GetBValue(AColor)*Inv255);
end;

procedure TVRML3DCanvas.AddAppearance;
begin
  AddAppearance(Brush.Color);
end;

procedure TVRML3DCanvas.AddAppearance(AColor:TColor);
begin
  IStrings.Add('              appearance Appearance {');
  IStrings.Add('                material Material {');

  if ITransp<>1 then
     IStrings.Add('        transparency '+FormatFloat('0.##',1-ITransp));

  IStrings.Add('                  diffuseColor '+VRMLColor(AColor));

  //IStrings.Add('                  ambientIntensity 0.2');
  //IStrings.Add('                  shininess 0.2');
  //IStrings.Add('                  specularColor '+VRMLColor(AColor));
  //IStrings.Add('                  emissiveColor '+VRMLColor(AColor));

  IStrings.Add('                }');
  IStrings.Add('              }');
end;

procedure TVRML3DCanvas.EndTransform;
begin
  IStrings.Add('            }');
  IStrings.Add('        ]');
  IStrings.Add('      }');
end;

function ValueToString(const Value:Double):String;
begin
  result:=FormatFloat('0.##',Value);
end;

procedure TVRML3DCanvas.Cone(Vertical: Boolean; Left, Top, Right, Bottom,
  Z0, Z1: Integer; Dark3D: Boolean; ConePercent: Integer);
begin
  AddTransform(Left,Top,Z0);
  IStrings.Add('            Shape {');
  IStrings.Add('              geometry Cone {');
  IStrings.Add('                height '+ValueToString((Bottom-Top)/300));
  IStrings.Add('                bottomRadius '+ValueToString(Abs(Right-Top)/300/2));
  IStrings.Add('              }');

  AddAppearance;
  EndTransform;
end;

procedure TVRML3DCanvas.Cube(Left, Right, Top, Bottom, Z0, Z1: Integer;
                             DarkSides: Boolean=True; RoundSize:Integer=0);
begin
  AddTransform(Left+((Right-Left) div 2),Top+((Bottom-Top) div 2),Z0+((Z1-Z0) div 2));
  IStrings.Add('            Shape {');
  IStrings.Add('              geometry Box {');
  IStrings.Add('                size '+ABCToString((Right-Left)/300,(Bottom-Top)/300,(Z1-Z0)/300));
  IStrings.Add('              }');

  AddAppearance;
  EndTransform;
end;

procedure TVRML3DCanvas.Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,
                                Z0,Z1:Integer; Dark3D:Boolean=True);
Begin
  AddTransform(Left,Top,Z0);
  IStrings.Add('            Shape {');
  IStrings.Add('              geometry Cylinder {');
  IStrings.Add('                height '+ValueToString((Bottom-Top)/300));
  IStrings.Add('                radius '+ValueToString((Right-Left)/300/2));
  IStrings.Add('              }');

  AddAppearance;
  EndTransform;
end;

procedure TVRML3DCanvas.Rectangle(const X0,Y0,X1,Y1:Integer);
begin
  Rectangle(X0,Y0,X1,Y1,0);
end;

Procedure TVRML3DCanvas.RectangleZ(const Left,Top,Bottom,Z0,Z1:Integer);
begin
  Polygon3D([ Point3D(Left,Top,Z0), Point3D(Left,Bottom,Z0),
              Point3D(Left,Bottom,Z1), Point3D(Left,Top,Z1) ]);
end;

Procedure TVRML3DCanvas.RectangleY(const Left,Top,Right,Z0,Z1:Integer);
begin
  Polygon3D([ Point3D(Left,Top,Z0), Point3D(Right,Top,Z0),
              Point3D(Right,Top,Z1), Point3D(Left,Top,Z1) ]);
end;

procedure TVRML3DCanvas.RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer);
begin
  // Pending
  Rectangle(X1,Y1,X2,Y2);
end;

procedure TVRML3DCanvas.Sphere(x,y,z:Integer; Const Radius:Double);
begin
  AddTransform(X,Y,Z);
  IStrings.Add('            Shape {');
  IStrings.Add('              geometry Sphere {');
  IStrings.Add('                radius '+FormatFloat('#.##',Radius/300));
  IStrings.Add('              }');

  AddAppearance;
  EndTransform;
end;

procedure TVRML3DCanvas.EndEntity;
begin
  inherited;
end;

procedure TVRML3DCanvas.EraseBackground(const Rect: TRect);
begin
//  inherited;
end;

Function TVRML3DCanvas.GetSupports3DText:Boolean;
begin
  result:=True;
end;

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

Function TVRML3DCanvas.GetSupportsXORMode:Boolean;
begin
  result:=False;
end;

procedure TVRML3DCanvas.LineTo(const X, Y: Integer);
begin
  LineTo3D(X,Y,0);
end;

procedure TVRML3DCanvas.LineTo3D(const X, Y, Z: Integer);
var P : Array[0..1] of TPoint3D;
begin
  P[0]:=Point3D(FX,FY,Z);
  P[1]:=Point3D(X,Y,Z);
  Polyline(P);
end;

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

procedure TVRML3DCanvas.MoveTo(const X,Y:Integer);
begin
  MoveTo3D(X,Y,0);
end;

function TVRML3DCanvas.AllPoints(const Rect:TRect; Z:Integer):String;
var P : TPointArray;
begin
  SetLength(P,4);
  P[0]:=Rect.TopLeft;
  P[1]:=TeePoint(Rect.Right,Rect.Top);
  P[2]:=Rect.BottomRight;
  P[3]:=TeePoint(Rect.Left,Rect.Bottom);
  result:=AllPoints(P,Z);
  P:=nil;
end;

function TVRML3DCanvas.AllPoints(const Points: Array of TPoint; Z:Integer):String;
var t : Integer;
begin
  Assert(Length(Points)>0,'Points must not be empty.');

  with Points[0] do
       result:=XYZ(X,Y,Z);

  for t:=1 to Length(Points)-1 do
  with Points[t] do
       result:=result+', '+XYZ(X,Y,Z);
end;

function TVRML3DCanvas.AllPoints(const Points: Array of TPoint3D):String;
var t : Integer;
begin
  Assert(Length(Points)>0,'Points must not be empty.');

  with Points[0] do
       result:=XYZ(X,Y,Z);

  for t:=1 to Length(Points)-1 do
  with Points[t] do
       result:=result+', '+XYZ(X,Y,Z);
end;

function TVRML3DCanvas.AllPoints(const Points: Array of TPoint3DFloat):String;
var t : Integer;
begin
  Assert(Length(Points)>0,'Points must not be empty.');

  with Points[0] do
       result:=XYZ(X,Y,Z);

  for t:=1 to Length(Points)-1 do
  with Points[t] do
       result:=result+', '+XYZ(X,Y,Z);
end;

procedure TVRML3DCanvas.Polygon({$IFDEF D6}const{$ENDIF} Points: array of TPoint);
begin
  PolygonWithZ(Points,0);
end;

function TVRML3DCanvas.Indexes(Max:Integer):String;
var t : Integer;
begin
  result:='0';
  for t:=1 to Max-1 do
      result:=result+' '+IntToStr(t);
end;

Procedure TVRML3DCanvas.Polygon3DFloat(const Points: Array of TPoint3DFloat);
begin
  InternalPolygon3D(AllPoints(Points),Length(Points));

  if Pen.Style<>psClear then
  begin
    IClosedLine:=True;
    Polyline(Points);
    IClosedLine:=False;
  end;
end;

Procedure TVRML3DCanvas.Polygon3D(const Points: Array of TPoint3D);
begin
  InternalPolygon3D(AllPoints(Points),Length(Points));

  if Pen.Style<>psClear then
  begin
    IClosedLine:=True;
    Polyline(Points);
    IClosedLine:=False;
  end;
end;

Procedure TVRML3DCanvas.InternalPolygon3D(const Points: String; ALength:Integer);
begin
  if Brush.Style<>bsClear then
  begin
    AddTransform(0,0,0);
    IStrings.Add('      Shape {');

    IStrings.Add('        geometry IndexedFaceSet {');
    IStrings.Add('          coord Coordinate {');
    IStrings.Add('            point [ '+Points+' ]');
    IStrings.Add('          }');
    IStrings.Add('            coordIndex [ '+Indexes(ALength)+' ]');
    IStrings.Add('            color Color { color [ '+VRMLColor(Brush.Color)+' ] }');
    IStrings.Add('            colorPerVertex FALSE');
    IStrings.Add('            solid FALSE');
    IStrings.Add('        }');

    AddAppearance;
    EndTransform;
  end;
end;

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

var tmpX,
    tmpZ : Integer;
    V1,
    V2 : TSurfaceVertex;
begin
  IClosedLine:=Pen.Style<>psClear;

  for tmpX:=2 to NumXValues do
  begin
    tmpZ:=0;

    CalcPoints(tmpX,tmpZ+1,False,V1);

    if V1.Flag then
    begin
      while tmpZ<NumZValues-1 do
      begin
        Inc(tmpZ);

        CalcPoints(tmpX,tmpZ+1,not SameBrush,V2);

        if V2.Flag and (V2.C0<>clNone) then
        begin
          Brush.Color:=V2.C0;
          Polygon3DFloat([V1.P0,V1.P1,V2.P1,V2.P0]);
        end;

        V1.P0:=V2.P0;
        V1.P1:=V2.P1;
      end;
    end;
  end;

  IClosedLine:=False;
end;

procedure TVRML3DCanvas.PolygonWithZ(const Points: Array of TPoint; Z:Integer);
begin
  if Brush.Style<>bsClear then
  begin
    AddTransform(0,0,0);
    IStrings.Add('      Shape {');

    IStrings.Add('        geometry IndexedFaceSet {');
    IStrings.Add('          coord Coordinate {');
    IStrings.Add('            point [ '+AllPoints(Points,Z)+' ]');
    IStrings.Add('          }');
    IStrings.Add('            coordIndex [ '+Indexes(Length(Points))+' ]');
    IStrings.Add('            color Color { color [ '+VRMLColor(Brush.Color)+' ] }');


    IStrings.Add('            solid FALSE');
    IStrings.Add('            colorPerVertex FALSE');
    IStrings.Add('            ccw FALSE');
    IStrings.Add('        }');

    AddAppearance;
    EndTransform;
  end;

  if Pen.Style<>psClear then
  begin
    IClosedLine:=True;
    Polyline(Points,Z);
    IClosedLine:=False;
  end;
end;

Procedure TVRML3DCanvas.Polyline({$IFDEF D6}const{$ENDIF} Points:Array of TPoint);
begin
  Polyline(Points,0);
end;

Procedure TVRML3DCanvas.Polyline(const Points:Array of TPoint3D);

  function FirstPoint:String;
  begin
    if IClosedLine then
       with Points[0] do
            result:=', '+XYZ(X,Y,Z)
    else
       result:='';
  end;

  function FirstIndex:String;
  begin
    if IClosedLine then result:=' 0'
                   else result:='';
  end;

begin
  AddTransform(0,0,0);
  IStrings.Add('      Shape {');

  IStrings.Add('        geometry IndexedLineSet {');
  IStrings.Add('          coord Coordinate {');
  IStrings.Add('            point [ '+AllPoints(Points)+FirstPoint+' ]');
  IStrings.Add('          }');
  IStrings.Add('            coordIndex [ '+Indexes(Length(Points))+FirstIndex+' ]');
  IStrings.Add('            color Color { color [ '+VRMLColor(Pen.Color)+' ] }');
  IStrings.Add('            colorPerVertex FALSE');
  IStrings.Add('            colorIndex [ 0 ]');
  IStrings.Add('        }');

  EndTransform;

  MoveTo3D(Points[Length(Points)-1]);
end;

Procedure TVRML3DCanvas.Polyline(const Points:Array of TPoint3DFloat);

  function FirstPoint:String;
  begin
    if IClosedLine then
       with Points[0] do
            result:=', '+XYZ(X,Y,Z)
    else
       result:='';
  end;

  function FirstIndex:String;
  begin
    if IClosedLine then result:=' 0'
                   else result:='';
  end;

begin
  AddTransform(0,0,0);
  IStrings.Add('      Shape {');

  IStrings.Add('        geometry IndexedLineSet {');
  IStrings.Add('          coord Coordinate {');
  IStrings.Add('            point [ '+AllPoints(Points)+FirstPoint+' ]');
  IStrings.Add('          }');
  IStrings.Add('            coordIndex [ '+Indexes(Length(Points))+FirstIndex+' ]');
  IStrings.Add('            color Color { color [ '+VRMLColor(Pen.Color)+' ] }');
  IStrings.Add('            colorPerVertex FALSE');
  IStrings.Add('            colorIndex [ 0 ]');
  IStrings.Add('        }');

  EndTransform;

  // Cannot use MoveTo3D(Point3D) here:
  with Points[Length(Points)-1] do
       MoveTo3D(X,Y,Z);
end;

Procedure TVRML3DCanvas.Polyline(const Points:Array of TPoint; Z:Integer);

  function FirstPoint:String;
  begin
    if IClosedLine then
        with Points[0] do
             result:=', '+XYZ(X,Y,Z)
    else
       result:='';
  end;

  function FirstIndex:String;
  begin
    if IClosedLine then result:=' 0'
                   else result:='';
  end;

begin
  AddTransform(0,0,0);
  IStrings.Add('      Shape {');

  IStrings.Add('        geometry IndexedLineSet {');
  IStrings.Add('          coord Coordinate {');
  IStrings.Add('            point [ '+AllPoints(Points,Z)+FirstPoint+' ]');
  IStrings.Add('          }');
  IStrings.Add('            coordIndex [ '+Indexes(Length(Points))+FirstIndex+' ]');
  IStrings.Add('            color Color { color [ '+VRMLColor(Pen.Color)+' ] }');
  IStrings.Add('            colorPerVertex FALSE');
  IStrings.Add('            colorIndex [ 0 ]');
  IStrings.Add('        }');

//  AddAppearance(Pen.Color);

  EndTransform;

  with Points[Length(Points)-1] do
       MoveTo3D(X,Y,Z);
end;

procedure TVRML3DCanvas.RectangleWithZ(const Rect: TRect; Z: Integer);
begin
  PolygonWithZ([Rect.TopLeft,TeePoint(Rect.Right,Rect.Top),
                Rect.BottomRight,TeePoint(Rect.Left,Rect.Bottom)],Z);
end;

procedure TVRML3DCanvas.StretchDraw(const Rect: TRect; const Graphic: TGraphic);
begin
  Draw(Rect.Left,Rect.Top,Graphic);
end;

procedure TVRML3DCanvas.TextOut3D(X, Y, Z: Integer; const Text: String; AllowHTML:Boolean=False);

  function FontName:String;
  begin
    result:=Font.Name;

    // 'SANS';
    // 'TYPEWRITER'
    // 'SERIF';
  end;

var
  tmpTextAlign : TCanvasTextAlign;

  function TextAlignString:String;
  begin
    case tmpTextAlign of
      TA_LEFT: result:='BEGIN';
    TA_CENTER: result:='MIDDLE';
     TA_RIGHT: result:='END';
    end;
  end;

begin
  tmpTextAlign:=TextAlign;

  if tmpTextAlign>=TA_BOTTOM then
  begin
//    Dec(Y,TextHeight(Text));
    Dec(tmpTextAlign,TA_BOTTOM);
  end
  else
    Inc(Y,TextHeight(Text)-2);

  AddTransform(X,Y,Z);
  IStrings.Add('                  Shape {');

  AddAppearance(Font.Color);

  IStrings.Add('                    geometry Text {');
  IStrings.Add('                      string [ "'+Text+'" ]');

  if Font.InterCharSize<>0 then
  IStrings.Add('                      length [ '+IntToStr(Font.InterCharSize)+' ]');


  IStrings.Add('                      fontStyle FontStyle {');
  IStrings.Add('                        family [ "'+FontName+'" ]');
  IStrings.Add('                        justify [ "'+TextAlignString+'" ]');
  IStrings.Add('                        size '+ValueToString(Font.Size*0.006));

  if fsBold in Font.Style then
     if fsItalic in Font.Style then
        IStrings.Add('             style "BOLDITALIC"')
     else
        IStrings.Add('             style "BOLD"')
  else
     if fsItalic in Font.Style then
        IStrings.Add('             style "ITALIC"');

  IStrings.Add('                      }');
  IStrings.Add('                    }');

  EndTransform;
end;

Function TVRML3DCanvas.GetHandle:TTeeCanvasHandle;
begin
  result:=0;
end;

function TVRML3DCanvas.GetIsNoBMPGrid: Boolean;
begin
  result:=False;
end;

procedure TVRML3DCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
  SetPixel3D(X,Y,0,Value);
end;

procedure TVRML3DCanvas.SetPixel3D(X, Y, Z: Integer; Value: TColor);
begin
  AddTransform(0,0,0);
  IStrings.Add('      Shape {');

  IStrings.Add('        geometry PointSet {');
  IStrings.Add('          coord Coordinate {');
  IStrings.Add('            point [ '+ABCToString(X,Y,Z)+' ]');
  IStrings.Add('          }');
  IStrings.Add('        }');

  AddAppearance(Value);
  EndTransform;
end;

procedure TVRML3DCanvas.Pyramid( Vertical:Boolean;
                                 Left,Top,Right,Bottom,z0,z1:Integer;
                                 DarkSides:Boolean=True);
begin
  AddTransform(0,0,0);
  IStrings.Add('      Shape {');

  IStrings.Add('        geometry IndexedFaceSet {');
  IStrings.Add('          coord Coordinate {');

  //  IStrings.Add('            point [ ''1 0 -1, -1 0 -1, -1 0 1, 1 0 1, 0 2 0 ]');

  IStrings.Add('            point [ '+XYZ(Right,Bottom,z0)+', '+
                                      XYZ(Left,Bottom,z0)+', '+
                                      XYZ(Left,Bottom,z1)+', '+
                                      XYZ(Right,Bottom,z1)+', '+
                                      XYZ((Left+Right) div 2,Top,(z0+z1) div 2)+
                                      ' ]');

  IStrings.Add('          }');
  IStrings.Add('          coordIndex [ 0 4 3 -1');
  IStrings.Add('                       1 4 0 -1');
  IStrings.Add('                       2 4 1 -1');
  IStrings.Add('                       3 4 2 -1');
  IStrings.Add('                       0 3 2  1 ]');
  IStrings.Add('        }');

  AddAppearance;
  EndTransform;
end;

{
Procedure TVRML3DCanvas.PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
                              TruncX,TruncZ:Integer);
begin
  Pyramid(True,R.Left,R.Top,R.Right,R.Bottom,StartZ,EndZ);
end;
}

procedure TVRML3DCanvas.GradientFill(const Rect: TRect; StartColor,
  EndColor: TColor; Direction: TGradientDirection; Balance, RadialX,
  RadialY: Integer);

  function AllColors:String;
  begin
    result:=VRMLColor(StartColor)+' '+VRMLColor(EndColor);
  end;

begin
  AddTransform(0,0,0);
  IStrings.Add('      Shape {');

  IStrings.Add('        geometry IndexedFaceSet {');
  IStrings.Add('          coord Coordinate {');
  IStrings.Add('            point [ '+AllPoints(Rect,GradientZ)+' ]');
  IStrings.Add('          }');
  IStrings.Add('            coordIndex [ 0 1 2 3 ]');
  IStrings.Add('            color Color { color [ '+AllColors+' ] }');

  IStrings.Add('            colorIndex [ 0 1 0 1 ]');


  IStrings.Add('            solid FALSE');
  IStrings.Add('            colorPerVertex TRUE');
  IStrings.Add('        }');

  EndTransform;
end;

procedure TVRMLOptions.BRunClick(Sender: TObject);
var tmp : String;
begin
  with TVRMLExportFormat.Create do
  try
    Panel:=Self.Panel;
    tmp:=TTeeExportFormBase.GetTempFolder+'\'+Panel.Name+'.'+FileExtension;
    SaveToFile(tmp);
  finally
    Free;
  end;

  TeeGotoURL(Handle,tmp);
end;

function TVRML3DCanvas.GetUseBuffer: Boolean;
begin
  result:=False;
end;

procedure TVRML3DCanvas.SetUseBuffer(Value: Boolean);
begin
end;

procedure TVRML3DCanvas.TextOut(X, Y: Integer; const Text: String);
begin
  TextOut3D(X,Y,0,Text);
end;

procedure TVRML3DCanvas.Plane3D(Const A,B:TPoint; Z0,Z1:Integer);
begin
  Polygon3D( [ Point3D(A,Z0), Point3D(B,Z0), Point3D(B,Z1), Point3D(A,Z1) ]);
end;

procedure TVRML3DCanvas.PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer);
begin
  Polygon3D( [ Point3D(Points[0],Z0), Point3D(Points[1],Z0),
               Point3D(Points[2],Z1), Point3D(Points[3],Z1) ]);
end;

procedure TVRML3DCanvas.TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer);
begin
  Polygon3D( [ Point3D(P1,Z), Point3D(P2,Z), Point3D(P3,Z) ]);
end;

procedure TVRML3DCanvas.Triangle3D( Const Points:TTrianglePoints3D;
                                    Const Colors:TTriangleColors3D);
begin
  if Brush.Style<>bsClear then
  begin
    AddTransform(0,0,0);
    IStrings.Add('      Shape {');

    IStrings.Add('        geometry IndexedFaceSet {');
    IStrings.Add('          coord Coordinate {');
    IStrings.Add('            point [ '+AllPoints(Points)+' ]');
    IStrings.Add('          }');
    IStrings.Add('            coordIndex [ '+Indexes(Length(Points))+' ]');
    IStrings.Add('            color Color { color [ '+VRMLColor(Colors[0])+', '+VRMLColor(Colors[1])+', '+VRMLColor(Colors[2])+' ] }');
    IStrings.Add('            colorIndex [ 0 1 2 ]');
    IStrings.Add('            colorPerVertex TRUE');
    IStrings.Add('            solid FALSE');
    IStrings.Add('        }');

    AddAppearance;
    EndTransform;
  end;

  if Pen.Style<>psClear then
  begin
    IClosedLine:=True;
    Polyline(Points);
    IClosedLine:=False;
  end;
end;

procedure TVRML3DCanvas.RotateLabel3D(x,y,z:Integer; const St:String; RotDegree:Double;
                                      AllowHTML:Boolean=False);
begin
  if RotDegree=0 then
     TextOut3D(x,y,z,St)
  else
  begin
    IStrings.Add('      Transform {');
    IStrings.Add('        rotation '+XYZ(0,RotDegree,Z));
    IStrings.Add('        children [');

    TextOut3D(x,y,z,St);
    EndTransform;
  end;
end;

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

procedure TVRML3DCanvas.FillRect(const Rect: TRect);
begin
  Pen.Style:=psClear;
  Rectangle(Rect);
end;

procedure TVRML3DCanvas.Calculate2DPosition(var x, y: Integer; z: Integer);
begin
  // Do nothing.
end;

function TVRML3DCanvas.GetPixel(x, y: Integer): TColor;
begin
  result:=GetPixel3D(x,y,0);
end;

function TVRML3DCanvas.GetPixel3D(X, Y, Z: Integer): TColor;
begin
  result:=0; // How to obtain a pixel color??
end;

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

const
  NumPoints=100;

procedure TVRML3DCanvas.EllipseWithZ(const X1, Y1, X2, Y2, Z: Integer);
var P : TPointArray;
    t : Integer;
    tmpCenter : TPoint;
    tmpRadius : TPoint;
    tmp       : Double;
    tmpSin    : Extended;
    tmpCos    : Extended;
begin
  SetLength(P,NumPoints);

  tmpCenter.X:=(X1+X2) div 2;
  tmpCenter.Y:=(Y1+Y2) div 2;

  tmpRadius.X:=(X2-X1) div 2;
  tmpRadius.Y:=(Y2-Y1) div 2;

  tmp:=2*Pi/(NumPoints-1);

  for t:=0 to NumPoints-1 do
  begin
    SinCos(tmp*t,tmpSin,tmpCos);

    P[t].X:=Round(tmpCenter.X+tmpRadius.X*tmpCos);
    P[t].Y:=Round(tmpCenter.Y+tmpRadius.Y*tmpSin);
  end;

  PolygonWithZ(P,Z);
  P:=nil;
end;

procedure TVRML3DCanvas.Invalidate;
begin
  // Do nothing.
end;

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

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

procedure TVRML3DCanvas.Arrow(Filled: Boolean; const FromPoint,
  ToPoint: TPoint; ArrowWidth, ArrowHeight, Z0,Z1: Integer;
  const ArrowPercent: Double);
var tmpP : TPointArray;
begin
  tmpP:=GetArrowPoints(ArrowPercent,FromPoint,ToPoint,ArrowWidth,ArrowHeight);

  if Assigned(tmpP) then  // if at least one pixel...
  Begin
    if Filled then
       PolygonWithZ(tmpP,Z0)
    else
    begin
      LineWithZ(FromPoint,tmpP[4],Z0);
      LineTo3D(tmpP[5].X,tmpP[5].Y,Z0);
      LineWithZ(tmpP[4],tmpP[3],Z0);
    end;

    tmpP:=nil;
  end;
end;

procedure TVRML3DCanvas.ClipRectangle(const Rect: TRect);
begin
end;

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

procedure TVRML3DCanvas.Draw(X, Y: Integer; const Graphic: TGraphic);
begin
  if Assigned(Graphic) and (not Graphic.Empty) then
  begin
    // Rectangle Texture??
    Rectangle(X,Y,X+Graphic.Width,Y+Graphic.Height);
  end;
end;

procedure TVRML3DCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
end;

procedure TVRML3DCanvas.Pie(const R: TRect; const StartAngle, EndAngle: Double);
begin
  {$IFDEF D6}
  inherited;
  {$ELSE}
  {$ENDIF}
end;

procedure TVRML3DCanvas.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);
begin
  // Not implemented
end;

procedure TVRML3DCanvas.PlaneWithZ(P1, P2, P3, P4: TPoint; Z: Integer);
begin
  Polygon3D( [ Point3D(P1,Z), Point3D(P2,Z), Point3D(P3,Z), Point3D(P4,Z) ]);
end;

procedure TVRML3DCanvas.UnClipRectangle;
begin
end;

initialization
  RegisterTeeExportFormat(TVRMLExportFormat);
finalization
  UnRegisterTeeExportFormat(TVRMLExportFormat);
end.
