New component : TGBECylinderExtend

TGBECylinderExtend descend du TCylinder mais il permet d'affecter des matériaux différents sur le haut, le bas et le côté du cylindre.
Une nouvelle démo est fournie utilisant le TGBECylinderExtend.

Author: gbegreg

GBE3D.dpk

@@ -44,6 +44,7 @@ contains
   GBEJoystick in 'GBEJoystick.pas',
   GBEConeExtend in 'GBEConeExtend.pas',
   GBEClouds in 'GBEClouds.pas',
-  GBEPlaneExtend in 'GBEPlaneExtend.pas';
+  GBEPlaneExtend in 'GBEPlaneExtend.pas',
+  GBECylinderExtend in 'GBECylinderExtend.pas';
 
 end.

GBE3D.dproj

@@ -105,6 +105,7 @@
         <DCCReference Include="GBEConeExtend.pas"/>
         <DCCReference Include="GBEClouds.pas"/>
         <DCCReference Include="GBEPlaneExtend.pas"/>
+        <DCCReference Include="GBECylinderExtend.pas"/>
         <BuildConfiguration Include="Release">
             <Key>Cfg_2</Key>
             <CfgParent>Base</CfgParent>
@@ -152,7 +153,7 @@
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl\GBE3D.bpl" Configuration="Debug" Class="ProjectOutput">
+                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\21.0\Bpl\GBE3D.bpl" Configuration="Debug" Class="ProjectOutput">
                     <Platform Name="Win32">
                         <RemoteName>GBE3D.bpl</RemoteName>
                         <Overwrite>true</Overwrite>

GBECylinderExtend.pas

@@ -0,0 +1,114 @@
+unit GBECylinderExtend;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, FMX.Types, FMX.Controls3D, FMX.Objects3D, FMX.Types3D, FMX.MaterialSources, System.Math.Vectors;
+
+type
+  TCustomMeshHelper = class(TCustomMesh);
+  TGBECylinderExtend = class(TCylinder)
+  private
+    { Déclarations privées }
+    fDiskTop, fDiskBottom : TDisk;
+    FMaterialSourceTop, FMaterialSourceBottom : TMaterialSource;
+    procedure CreateGBECylinder;
+    procedure setMaterialSourceBottom(const Value: TMaterialSource);
+    procedure setMaterialSourceTop(const Value: TMaterialSource);
+  protected
+    { Déclarations protégées }
+  public
+    { Déclarations publiques }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Render; override;
+  published
+    { Déclarations publiées }
+    property MaterialSourceTop : TMaterialSource read FMaterialSourceTop write setMaterialSourceTop;
+    property MaterialSourceBottom : TMaterialSource read FMaterialSourceBottom write setMaterialSourceBottom;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('GBE3D', [TGBECylinderExtend]);
+end;
+
+{ TMesh1 }
+
+constructor TGBECylinderExtend.Create(AOwner: TComponent);
+begin
+  inherited;
+  CreateGBECylinder;
+end;
+
+procedure TGBECylinderExtend.CreateGBECylinder;
+begin
+  fDiskTop:=TDisk.Create(nil);
+  fDiskTop.Locked := true;
+  fDiskTop.Stored := false;
+  fDiskTop.SubdivisionsAxes:=SubdivisionsAxes;
+  fDiskTop.SubdivisionsCap:=SubdivisionsCap;
+  fDiskTop.Parent := self;
+  fDiskTop.Position.Y := - fHeight * 0.5;
+  fDiskTop.Height := fHeight;
+  fDiskTop.Width := fWidth;
+  fDiskTop.Depth := fDepth;
+  fDiskTop.MaterialSource := MaterialSourceTop;
+
+  fDiskBottom:=TDisk.Create(nil);
+  fDiskBottom.Locked := true;
+  fDiskBottom.Stored := false;
+  fDiskBottom.SubdivisionsAxes:=SubdivisionsAxes;
+  fDiskBottom.SubdivisionsCap:=SubdivisionsCap;
+  fDiskBottom.Parent := self;
+  fDiskBottom.Position.Y := fHeight * 0.5 + 0.001;
+  fDiskBottom.Height := fHeight;
+  fDiskBottom.Width := fWidth;
+  fDiskBottom.Depth := fDepth;
+  fDiskBottom.MaterialSource := MaterialSourceBottom;
+end;
+
+destructor TGBECylinderExtend.Destroy;
+begin
+  DoDeleteChildren;
+  inherited;
+end;
+
+procedure TGBECylinderExtend.Render;
+begin
+  inherited;
+
+  fDiskTop.SubdivisionsAxes:=SubdivisionsAxes;
+  fDiskTop.SubdivisionsCap:=SubdivisionsCap;
+  fDiskTop.Position.Y := - fHeight * 0.5;
+  fDiskTop.Height := fHeight;
+  fDiskTop.Width := fWidth;
+  fDiskTop.Depth := fDepth;
+
+  fDiskBottom.SubdivisionsAxes:=SubdivisionsAxes;
+  fDiskBottom.SubdivisionsCap:=SubdivisionsCap;
+  fDiskBottom.Position.Y := fHeight * 0.5 + 0.001;
+  fDiskBottom.Height := fHeight;
+  fDiskBottom.Width := fWidth;
+  fDiskBottom.Depth := fDepth;
+end;
+
+procedure TGBECylinderExtend.setMaterialSourceBottom(
+  const Value: TMaterialSource);
+begin
+  FMaterialSourceBottom := Value;
+  fDiskBottom.MaterialSource := FMaterialSourceBottom;
+end;
+
+procedure TGBECylinderExtend.setMaterialSourceTop(
+  const Value: TMaterialSource);
+begin
+  FMaterialSourceTop := Value;
+  fDiskTop.MaterialSource := FMaterialSourceTop;
+end;
+
+end.

demos/CylinderExtend/Unit1.fmx

@@ -0,0 +1,34 @@
+unit Unit1;
+
+interface
+
+uses
+  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
+  System.Math.Vectors, FMX.Types3D, FMX.Controls3D, FMX.MaterialSources,
+  FMX.Objects3D, FMX.Viewport3D, FMX.Ani, GBECylinderExtend;
+
+type
+  TForm1 = class(TForm)
+    Viewport3D1: TViewport3D;
+    LightMaterialSource1: TLightMaterialSource;
+    Light1: TLight;
+    LightMaterialSource2: TLightMaterialSource;
+    Light2: TLight;
+    GBECylinderExtend1: TGBECylinderExtend;
+    FloatAnimation1: TFloatAnimation;
+    LightMaterialSource3: TLightMaterialSource;
+  private
+    { Déclarations privées }
+  public
+    { Déclarations publiques }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.fmx}
+
+end.

demos/CylinderExtend/Unit1.pas

@@ -0,0 +1,14 @@
+program demoCylinderExtend;
+
+uses
+  System.StartUpCopy,
+  FMX.Forms,
+  Unit1 in 'Unit1.pas' {Form1};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.