Skip to content

Instantly share code, notes, and snippets.

@rickwheeler

rickwheeler/FMX.MeshObjects.pas

Forked from UweRaabe/FMX.MeshObjects.pas
Last active February 16, 2016 23:01
Show Gist options
  • Save rickwheeler/17c6b91a1e357b2851d4 to your computer and use it in GitHub Desktop.
Save rickwheeler/17c6b91a1e357b2851d4 to your computer and use it in GitHub Desktop.
Download ZIP
Support for Delphi XE5-XE7
Raw
FMX.MeshObjects.pas
unit FMX.MeshObjects;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.RTLConsts,
System.Math, System.UIConsts, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Controls3D,
FMX.Types3D, FMX.Objects3D, FMX.Layers3D, FMX.Objects, FMX.Menus, FMX.Edit, FMX.Colors, FMX.MaterialSources,
System.StrUtils, System.Generics.Collections, FMX.Ani, FMX.Materials, System.Generics.Defaults;
Type
TSectionType = (sctNone, sctTop, sctBottom);
TFrameType = (ftEllipse, ftRectangle);
TPointArray = array of TPoint3d;
TDummyPointLayer = class;
TPoint3DHelper = record helper for TPoint3D
public
class function Zero: TPoint3D; static;
end;
TPointLayer = class(TObject)
private
FParent: TPointLayer;
FChild: TPointLayer;
FContent: TPointLayer;
FPosition: TPosition3d;
FLocalMatrix: TMatrix3D;
FRotationAngle: TPosition3d;
FQuaternion: TQuaternion3D;
FScale: TPosition3d;
FSavedAbsoluteMatrix: TMatrix3D;
FAbsMatrixNeedRefresh: Boolean;
FGapLayer: Boolean;
function GetLength: Integer;
procedure SetPointsLength(const Value: Integer);
Procedure MatrixChanged(Sender: TObject);
procedure RotationChanged(Sender: TObject); virtual;
function GetAbsoluteMatrix: TMatrix3D;
function GetRealParent: TPointLayer;
function GetRealChild: TPointLayer;
function GetLayerCount: Integer;
function GetFirstParent: TPointLayer;
function GetDummyChild: TPointLayer;
function GeAbsoluteCenter: TPoint3d;
function GetLayerH: Single;
protected
Procedure CreateDummies; virtual;
public
Points: TPointArray;
Constructor Create;
Destructor Destroy; override;
Function CreateChildAtPosition(CPos: TPoint3d; RepeatNbr: Integer): TPointLayer;
Procedure AddChild(CPointLayer: TPointLayer);
Function LastChild: TPointLayer;
Function RemoveFirstChild: TPointLayer;
Function Index: Integer;
Function GetLayer(LIndex: Integer): TPointLayer;
Function AbsPoint(i: Integer): TPoint3d;
Function GetTotalTurn: Single;
Function Content: TPointLayer;
Procedure InvalidateAbsoluteMatrix;
Property FirstParent: TPointLayer read GetFirstParent;
Property RealParent: TPointLayer read GetRealParent;
Property RealChild: TPointLayer read GetRealChild;
Property DummyChild: TPointLayer read GetDummyChild;
Property Length: Integer read GetLength write SetPointsLength;
Property Position: TPosition3d read FPosition write FPosition;
property AbsoluteMatrix: TMatrix3D read GetAbsoluteMatrix;
property LocalMatrix: TMatrix3D read FLocalMatrix;
Property AbsoluteCenter: TPoint3d read GeAbsoluteCenter;
Property LayerH: Single read GetLayerH;
Property GapLayer: Boolean read FGapLayer write FGapLayer;
property RotationAngle: TPosition3d read FRotationAngle write FRotationAngle;
property Scale: TPosition3d read FScale write FScale;
Property LayerCount: Integer read GetLayerCount;
end;
TDummyPointLayer = class(TPointLayer)
protected
Procedure CreateDummies; override;
end;
TLayerList = TList<TPointLayer>;
TAnnulus = class(TCustomMesh)
private
FSectionType: TSectionType;
FSectionDegree: Integer;
FInnerFrameType: TFrameType;
FOuterFrameType: TFrameType;
FDrawBounds: Boolean;
procedure SetThickness(const Value: Single);
procedure SetSubdivisionsAxes(const Value: Integer);
procedure SetSectionDegree(const Value: Integer);
procedure SetSectionType(const Value: TSectionType);
procedure setInnerFrameType(const Value: TFrameType);
procedure setOuterFrameType(const Value: TFrameType);
procedure SetDrawBounds(const Value: Boolean);
protected
FSubdivisionsAxes: Integer;
FUnitWidth: Single;
FUnitHeight: Single;
FThickness: Single;
FRenderScale: Single;
FStartAngle: Single;
FTotalAngle: Single;
FDistAngle: Single;
InnerPoints: TPointArray;
OuterPoints: TPointArray;
function ExtendPointToPlane(point, Plane, PlaneNormal: TPoint3D; var Distance: Single; var nPoint: TPoint3d): Boolean;
Procedure CalcPoints; virtual;
Procedure GetAnnulusPointsForPosY(PosY: Single; var IPoints, OPoints: TPointArray); virtual;
procedure BuildAnnulus(IPoints, OPoints: TPointArray; Back: Boolean); virtual;
procedure RebuildMesh; virtual;
procedure Render; override;
function FixHeight: Boolean; virtual;
procedure SetHeight(const Value: Single); override;
procedure SetWidth(const Value: Single); override;
procedure SetDepth(const Value: Single); override;
public
constructor Create(AOwner: TComponent); override;
property Data;
Property Thickness: Single read FThickness write SetThickness;
Property SubdivisionsAxes: Integer read FSubdivisionsAxes write SetSubdivisionsAxes;
Property SectionType: TSectionType read FSectionType write SetSectionType;
Property SectionDegree: Integer read FSectionDegree write SetSectionDegree;
Property InnerFrameType: TFrameType read FInnerFrameType write setInnerFrameType;
Property OuterFrameType: TFrameType read FOuterFrameType write setOuterFrameType;
Property RenderScale: Single read FRenderScale;
Property DrawBounds: Boolean read FDrawBounds write SetDrawBounds;
end;
TPipe = class;
TPipeModifier = class(TFMXObject)
private
FPipe: TPipe;
FStartPosition: Single;
FEndPosition: Single;
FSubdivisions: Integer;
FUseGap: Boolean;
FFirstCenter: TPoint3d;
FLastCenter: TPoint3d;
FModifyMargins: Boolean;
procedure SetStartPosition(const Value: Single);
procedure SetEndPosition(const Value: Single);
procedure SetSubdivisions(const Value: Integer);
function InsertPointLayer(StartLayer: TPointLayer; LayerH: Single; UseGap: Boolean = False): TPointLayer;
procedure SetModifyMargins(const Value: Boolean);
protected
FStartMargin: Single;
FEndMargin: Single;
FLayerCount: Integer;
StartLayer, EndLayer, StartMLayer, EndMLayer: TPointLayer;
Procedure BeginModify(StartPoints: TPointLayer); virtual;
public
Constructor Create(aPipe: TPipe); virtual;
Procedure ModifySubPoints(sPoints: TPointLayer; isInner: Boolean); virtual; abstract;
Procedure DoModify(StartPoints: TPointLayer); virtual;
Procedure EndModify; virtual;
published
Property StartPosition: Single read FStartPosition write SetStartPosition;
Property EndPosition: Single read FEndPosition write SetEndPosition;
Property Subdivisions: Integer read FSubdivisions write SetSubdivisions;
Property UseGap: Boolean read FUseGap write FUseGap;
Property FirstCenter: TPoint3d read FFirstCenter;
Property LastCenter: TPoint3d read FLastCenter;
Property ModifyMargins: Boolean read FModifyMargins write SetModifyMargins;
end;
TBendModifier = class(TPipeModifier)
private
FBendAngle: Single;
FTurnAngle: Single;
procedure SetBendAngle(const Value: Single);
procedure SetTurnAngle(const Value: Single);
public
Constructor Create(aPipe: TPipe); override;
Destructor Destroy; override;
Procedure ModifySubPoints(sPoints: TPointLayer; isInner: Boolean); override;
published
Property BendAngle: Single read FBendAngle write SetBendAngle;
Property TurnAngle: Single read FTurnAngle write SetTurnAngle;
end;
TBreakModifier = class(TBendModifier)
private
procedure SetEndMargin(const Value: Single);
procedure SetStartMargin(const Value: Single);
public
Constructor Create(aPipe: TPipe); override;
Procedure ModifySubPoints(sPoints: TPointLayer; isInner: Boolean); override;
Property StartMargin: Single read FStartMargin write SetStartMargin;
Property EndMargin: Single read FEndMargin write SetEndMargin;
end;
TTwistModifier = class(TPipeModifier)
private
FTotalRotation: Single;
procedure SetTotalRotation(const Value: Single);
public
Constructor Create(aPipe: TPipe); override;
Procedure ModifySubPoints(sPoints: TPointLayer; isInner: Boolean); override;
published
Property TotalRotation: Single read FTotalRotation write SetTotalRotation;
end;
TEmbossModifier = class(TPipeModifier)
private
FThicknessRatio: Single;
procedure SetThicknessRatio(const Value: Single);
public
Constructor Create(aPipe: TPipe); override;
Procedure ModifySubPoints(sPoints: TPointLayer; isInner: Boolean); override;
Property ThicknessRatio: Single read FThicknessRatio write SetThicknessRatio;
end;
TPipe = class(TAnnulus)
private
FModifiers: TList<TPipeModifier>;
FOnZAxis: Boolean;
FFirstCenter: TPoint3d;
FLastCenter: TPoint3d;
FScaleBeforeRender: Boolean;
Procedure SortModifiers;
procedure SetOnZAxis(const Value: Boolean);
procedure SetScaleBeforeRender(const Value: Boolean);
protected
function FixHeight: Boolean; override;
procedure SetHeight(const Value: Single); override;
Procedure GetAnnulusPointsForPosY(PosY: Single; var IPoints, OPoints: TPointArray); override;
procedure BuildSectionSurfaces(OuterSectionPoints, InnerSectionPoints: TPointArray); virtual;
procedure BuildCylinder(Points: TPointArray; Back: Boolean;
var SectionPoints, FirstPoints, LastPoints: TPointArray); virtual;
procedure RebuildMesh; override;
Procedure Render; override;
Procedure ModifiersNotify(Sender: TObject; Const Item: TPipeModifier; Action: TCollectionNotification);
public
constructor Create(AOwner: TComponent); override;
Procedure ClearModifiers;
destructor Destroy; override;
Property Modifiers: TList<TPipeModifier> read FModifiers;
Property OnZAxis: Boolean read FOnZAxis write SetOnZAxis;
Property FirstCenter: TPoint3d Read FFirstCenter;
Property LastCenter: TPoint3d read FLastCenter;
Property ScaleBeforeRender: Boolean read FScaleBeforeRender write SetScaleBeforeRender;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('3D Shapes', [TAnnulus, TPipe]);
end;
{ TPoint3DHelper }
class function TPoint3DHelper.Zero: TPoint3D;
begin
Result := Point3D(0,0,0);
end;
{ TPipe }
procedure TAnnulus.BuildAnnulus(IPoints, OPoints: TPointArray; Back: Boolean);
var
FData: TMeshData;
i: Integer;
vertexIdx: Integer;
indexIdx: Integer;
begin
FData := Self.Data;
vertexIdx := FData.VertexBuffer.Length;
indexIdx := FData.IndexBuffer.Length;
FData.VertexBuffer.Length := vertexIdx + FSubdivisionsAxes * 2;
for i := 0 to FSubdivisionsAxes - 1 do begin
FData.VertexBuffer.Vertices[vertexIdx + i] := IPoints[i];
FData.VertexBuffer.TexCoord0[vertexIdx + i] := Pointf((IPoints[i].X + FUnitWidth / 2) / FUnitWidth,
(IPoints[i].Z + FUnitHeight / 2) / FUnitHeight);
FData.VertexBuffer.Vertices[vertexIdx + i + FSubdivisionsAxes] := OPoints[i];
FData.VertexBuffer.TexCoord0[vertexIdx + i + FSubdivisionsAxes] :=
Pointf((OPoints[i].X + FUnitWidth / 2) / FUnitWidth, (OPoints[i].Z + FUnitHeight / 2) / FUnitHeight);
end;
FData.IndexBuffer.Length := indexIdx + FSubdivisionsAxes * 6;
if (FSectionType <> sctNone) then
FData.IndexBuffer.Length := FData.IndexBuffer.Length - 6;
for i := 0 to FSubdivisionsAxes - 1 do begin
if (i = FSubdivisionsAxes - 1) then begin
if (FSectionType = sctNone) then begin
FData.IndexBuffer.Indices[indexIdx + i * 6 + 0] := vertexIdx + i;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 1] := vertexIdx + 0;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 2] := vertexIdx + i + FSubdivisionsAxes;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 3] := vertexIdx + 0;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 4] := vertexIdx + FSubdivisionsAxes;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 5] := vertexIdx + i + FSubdivisionsAxes;
if Back then begin
FData.IndexBuffer.Indices[indexIdx + i * 6 + 2] := vertexIdx + i;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 1] := vertexIdx + 0;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 0] := vertexIdx + i + FSubdivisionsAxes;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 5] := vertexIdx + 0;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 4] := vertexIdx + FSubdivisionsAxes;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 3] := vertexIdx + i + FSubdivisionsAxes;
end;
end;
end
else begin
FData.IndexBuffer.Indices[indexIdx + i * 6] := vertexIdx + i;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 1] := vertexIdx + i + 1;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 2] := vertexIdx + i + FSubdivisionsAxes;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 3] := vertexIdx + i + 1;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 4] := vertexIdx + i + FSubdivisionsAxes + 1;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 5] := vertexIdx + i + FSubdivisionsAxes;
if Back then begin
FData.IndexBuffer.Indices[indexIdx + i * 6 + 2] := vertexIdx + i;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 1] := vertexIdx + i + 1;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 0] := vertexIdx + i + FSubdivisionsAxes;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 5] := vertexIdx + i + 1;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 4] := vertexIdx + i + FSubdivisionsAxes + 1;
FData.IndexBuffer.Indices[indexIdx + i * 6 + 3] := vertexIdx + i + FSubdivisionsAxes;
end;
end;
end;
end;
procedure TAnnulus.CalcPoints;
var
PhiSin, PhiCos: Extended;
iWidth, iHeight: Single;
rThickness: Single;
A: Integer;
Angle: Single;
rPoint: TPoint3d;
iPoint: TPoint3d;
iDist: Single;
uiWidth, uiHeight: Single;
begin
SetLength(OuterPoints, FSubdivisionsAxes);
SetLength(InnerPoints, FSubdivisionsAxes);
FUnitWidth := 1;
FUnitHeight := 1;
if Width > Depth then
FUnitWidth := Width / Depth;
if Depth > Width then
FUnitHeight := Depth / Width;
rThickness := FThickness * (FUnitWidth / Width);
FRenderScale := Width / FUnitWidth;
iWidth := 1;
iHeight := 1;
if (FThickness * 2 = Depth) or (FThickness * 2 = Width) then
FThickness := FThickness - 0.1;
if Width > Depth then
iWidth := (Width - (FThickness * 2)) / (Depth - (FThickness * 2));
if Depth > Width then
iHeight := (Depth - (FThickness * 2)) / (Width - (FThickness * 2));
FStartAngle := 0;
FTotalAngle := 360;
if FSectionType <> sctNone then
FTotalAngle := 360 - FSectionDegree;
if FSectionType = sctBottom then
FStartAngle := -(180 - FSectionDegree) / 2;
if FSectionType = sctTop then
FStartAngle := 180 - (180 - FSectionDegree) / 2;
FDistAngle := FTotalAngle / FSubdivisionsAxes;
if FSectionType <> sctNone then
FDistAngle := FTotalAngle / (FSubdivisionsAxes - 1);
for A := 0 to FSubdivisionsAxes - 1 do begin
Angle := DegToRad(FStartAngle) + DegToRad(FDistAngle) * A;
SinCos(Angle, PhiSin, PhiCos);
if FOuterFrameType = ftEllipse then begin
OuterPoints[A] := Point3D(PhiCos * 0.5 * FUnitWidth, 0, PhiSin * 0.5 * FUnitHeight);
end
else begin
rPoint := Point3D(PhiCos * 0.5 * FUnitWidth, 0, PhiSin * 0.5 * FUnitHeight);
iDist := -1;
iPoint := rPoint;
Self.ExtendPointToPlane(rPoint, Point3D(FUnitWidth / 2, 0, 0), Point3D(-1, 0, 0), iDist, iPoint);
Self.ExtendPointToPlane(rPoint, Point3D(0, 0, FUnitHeight / 2), Point3D(0, 0, -1), iDist, iPoint);
Self.ExtendPointToPlane(rPoint, Point3D(-FUnitWidth / 2, 0, 0), Point3D(1, 0, 0), iDist, iPoint);
Self.ExtendPointToPlane(rPoint, Point3D(0, 0, -FUnitHeight / 2), Point3D(0, 0, 1), iDist, iPoint);
OuterPoints[A] := iPoint;
end;
if FInnerFrameType = ftEllipse then begin
InnerPoints[A] := Point3D(PhiCos * (0.5 - rThickness) * iWidth, 0, PhiSin * (0.5 - rThickness) * iHeight);
end
else begin
rPoint := Point3D(PhiCos * (0.5 - rThickness) * iWidth, 0, PhiSin * (0.5 - rThickness) * iHeight);
uiWidth := (0.5 - rThickness) * iWidth;
uiHeight := (0.5 - rThickness) * iHeight;
iDist := -1;
iPoint := rPoint;
Self.ExtendPointToPlane(rPoint, Point3d(uiWidth, 0, 0), Point3d(-1, 0, 0), iDist, iPoint);
Self.ExtendPointToPlane(rPoint, Point3d(0, 0, uiHeight), Point3d(0, 0, -1), iDist, iPoint);
Self.ExtendPointToPlane(rPoint, Point3d(-uiWidth, 0, 0), Point3d(1, 0, 0), iDist, iPoint);
Self.ExtendPointToPlane(rPoint, Point3d(0, 0, -uiHeight), Point3d(0, 0, 1), iDist, iPoint);
InnerPoints[A] := iPoint;
end;
end;
end;
constructor TAnnulus.Create(AOwner: TComponent);
begin
inherited;
FThickness := 0.2;
FSubdivisionsAxes := 180;
FSectionType := sctNone;
FSectionDegree := 180;
FOuterFrameType := ftEllipse;
FInnerFrameType := ftEllipse;
RebuildMesh;
end;
function TAnnulus.ExtendPointToPlane(point, Plane, PlaneNormal: TPoint3D; var Distance: Single; var nPoint: TPoint3d):
Boolean;
var
iPoint: TVector3d;
aDist: Single;
begin
Result := False;
if RayCastPlaneIntersect(TPoint3D.Zero, point, Plane, PlaneNormal, iPoint) then begin
aDist := Sqrt(iPoint.Distance(TPoint3D.Zero));
if Distance = -1 then begin
Distance := aDist;
nPoint := iPoint.ToPoint3D;
Result := True;
end
else if aDist < Distance then begin
Distance := aDist;
nPoint := iPoint.ToPoint3D;
Result := True;
end;
end;
end;
function TAnnulus.FixHeight: Boolean;
begin
FHeight := 0.001;
Result := True;
end;
procedure TAnnulus.GetAnnulusPointsForPosY(PosY: Single; var IPoints, OPoints: TPointArray);
var
i: Integer;
begin
SetLength(IPoints, Length(InnerPoints));
SetLength(OPoints, Length(OuterPoints));
for i := 0 to High(InnerPoints) do begin
IPoints[i] := Point3D(InnerPoints[i].X, PosY, InnerPoints[i].Z);
OPoints[i] := Point3D(OuterPoints[i].X, PosY, OuterPoints[i].Z);
end;
end;
procedure TAnnulus.RebuildMesh;
var
IPoints, OPoints: TPointArray;
begin
CalcPoints;
Data.VertexBuffer.Length := 0;
Data.IndexBuffer.Length := 0;
GetAnnulusPointsForPosY(-0.001, IPoints, OPoints);
BuildAnnulus(IPoints, OPoints, True);
GetAnnulusPointsForPosY(0.001, IPoints, OPoints);
BuildAnnulus(IPoints, OPoints, False);
Data.CalcFaceNormals;
end;
procedure TAnnulus.Render;
begin
Context.SetMatrix(TMatrix3D.CreateScaling(TPoint3D.Create(FRenderScale, Height, FRenderScale)) * AbsoluteMatrix);
Context.DrawTriangles(Data.VertexBuffer, Data.IndexBuffer, TMaterialSource.ValidMaterial(MaterialSource),
AbsoluteOpacity);
if FDrawBounds then begin
Context.SetMatrix(AbsoluteMatrix);
Context.DrawCube(TPoint3D.Zero, Point3D(Width, 0, Depth), AbsoluteOpacity, TalphaColors.Red);
end;
end;
procedure TAnnulus.SetDepth(const Value: Single);
var
FRefresh: Boolean;
begin
FRefresh := (Self.Depth <> Value);
inherited;
if FRefresh then
RebuildMesh;
end;
procedure TAnnulus.SetDrawBounds(const Value: Boolean);
begin
FDrawBounds := Value;
Render;
end;
procedure TAnnulus.SetHeight(const Value: Single);
begin
if not FixHeight then
inherited;
end;
procedure TAnnulus.setInnerFrameType(const Value: TFrameType);
begin
FInnerFrameType := Value;
RebuildMesh;
end;
procedure TAnnulus.setOuterFrameType(const Value: TFrameType);
begin
FOuterFrameType := Value;
RebuildMesh;
end;
procedure TAnnulus.SetSectionDegree(const Value: Integer);
begin
FSectionDegree := Value;
RebuildMesh;
end;
procedure TAnnulus.SetSectionType(const Value: TSectionType);
begin
FSectionType := Value;
RebuildMesh;
end;
procedure TAnnulus.SetSubdivisionsAxes(const Value: Integer);
begin
FSubdivisionsAxes := Value;
RebuildMesh;
end;
procedure TAnnulus.SetThickness(const Value: Single);
begin
FThickness := Value;
RebuildMesh;
end;
procedure TAnnulus.SetWidth(const Value: Single);
var
FRefresh: Boolean;
begin
FRefresh := (Self.Width <> Value);
inherited;
if FRefresh then
RebuildMesh;
end;
{ TPipe }
procedure TPipe.BuildCylinder(Points: TPointArray; Back: Boolean;
var SectionPoints, FirstPoints, LastPoints: TPointArray);
var
FData: TMeshData;
i, h, k: Integer;
vertexIdx, pVertexIdx: Integer;
indexIdx: Integer;
hDist, hPos: Single;
PhiSin, PhiCos: Extended;
cntIndexInRow: Integer;
cntVertexInRow: Integer;
backM: Integer;
Angle: Single;
StartPoints: TPointLayer;
EndPoints: TPointLayer;
SubPoints: TPointArray;
done: Boolean;
PointsLen: Integer;
pModifier: TPipeModifier;
pLayer: TPointLayer;
LayerCount: Integer;
AbsStart: TPoint3d;
sctIndex: Integer;
begin
FData := Self.Data;
PointsLen := Length(Points);
StartPoints := TPointLayer.Create;
if FOnZAxis then
StartPoints.RotationAngle.Point := Point3D(90, 90, 0);
EndPoints := TPointLayer.Create;
StartPoints.AddChild(EndPoints);
StartPoints.Length := PointsLen;
EndPoints.Length := PointsLen;
StartPoints.Position.point := TPoint3D.Zero;
EndPoints.Position.point := Point3D(0, Height, 0);
for i := 0 to High(Points) do begin
StartPoints.Points[i] := Point3D(Points[i].X, 0, Points[i].Z);
EndPoints.Points[i] := Point3D(Points[i].X, 0, Points[i].Z);
end;
backM := 1;
if Back then
backM := -1;
for pModifier in FModifiers do begin
pModifier.DoModify(StartPoints);
end;
LayerCount := StartPoints.LayerCount;
cntIndexInRow := PointsLen * 6;
if FSectionType <> sctNone then begin
cntIndexInRow := (PointsLen - 1) * 6;
end;
if FScaleBeforeRender then begin
for i := 0 to LayerCount - 1 do begin
pLayer := StartPoints.GetLayer(i);
pLayer.Content.Scale.point := Point3D(pLayer.Content.Scale.point.X * FRenderScale, pLayer.Content.Scale.point.Y,
pLayer.Content.Scale.point.Z * FRenderScale);
end;
end;
AbsStart := Point3D(0, -Height / 2, 0);
StartPoints.InvalidateAbsoluteMatrix;
for i := 0 to LayerCount - 1 do begin
vertexIdx := FData.VertexBuffer.Length;
indexIdx := FData.IndexBuffer.Length;
pLayer := StartPoints.GetLayer(i);
FData.VertexBuffer.Length := vertexIdx + PointsLen;
for k := 0 to PointsLen - 1 do begin
FData.VertexBuffer.Vertices[vertexIdx + k] := pLayer.AbsPoint(k) + AbsStart;
FData.VertexBuffer.TexCoord0[vertexIdx + k] := Pointf(k / (PointsLen - 1), pLayer.Position.Y / Height);
end;
if (FSectionType <> sctNone) and (not pLayer.GapLayer) then begin
sctIndex := Length(SectionPoints);
SetLength(SectionPoints, sctIndex + 2);
SectionPoints[sctIndex] := pLayer.AbsPoint(PointsLen - 1) + AbsStart;
SectionPoints[sctIndex + 1] := pLayer.AbsPoint(0) + AbsStart;
end;
if (i > 0) and (not pLayer.GapLayer) then begin
FData.IndexBuffer.Length := indexIdx + cntIndexInRow;
pVertexIdx := vertexIdx - PointsLen;
for k := 0 to PointsLen - 1 do begin
if k = PointsLen - 1 then begin
if FSectionType = sctNone then begin
FData.IndexBuffer.Indices[indexIdx + k * 6 + 0] := vertexIdx;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 1] := vertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 2] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 3] := vertexIdx;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 4] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 5] := pVertexIdx;
if Back then begin
FData.IndexBuffer.Indices[indexIdx + k * 6 + 2] := vertexIdx;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 1] := vertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 0] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 5] := vertexIdx;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 4] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 3] := pVertexIdx;
end;
end;
end
else begin
FData.IndexBuffer.Indices[indexIdx + k * 6 + 0] := vertexIdx + k + 1;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 1] := vertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 2] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 3] := vertexIdx + k + 1;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 4] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 5] := pVertexIdx + k + 1;
if Back then begin
FData.IndexBuffer.Indices[indexIdx + k * 6 + 2] := vertexIdx + k + 1;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 1] := vertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 0] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 5] := vertexIdx + k + 1;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 4] := pVertexIdx + k;
FData.IndexBuffer.Indices[indexIdx + k * 6 + 3] := pVertexIdx + k + 1;
end;
end;
end;
end;
end;
SetLength(FirstPoints, PointsLen);
SetLength(LastPoints, PointsLen);
for i := 0 to StartPoints.Length - 1 do
FirstPoints[i] := StartPoints.AbsPoint(i) + AbsStart;
for i := 0 to EndPoints.Length - 1 do
LastPoints[i] := EndPoints.AbsPoint(i) + AbsStart;
FFirstCenter := StartPoints.AbsoluteCenter;
FLastCenter := EndPoints.AbsoluteCenter;
for pModifier in FModifiers do begin
pModifier.EndModify;
end;
StartPoints.Free;
end;
procedure TPipe.BuildSectionSurfaces(OuterSectionPoints, InnerSectionPoints: TPointArray);
var
p1, p2: TPoint3d;
i: Integer;
FData: TMeshData;
vertexIdx, indexIdx, vIdx: Integer;
LevelCount: Integer;
begin
FData := Self.Data;
LevelCount := System.Length(OuterSectionPoints) div 2;
// left
vertexIdx := FData.VertexBuffer.Length;
FData.VertexBuffer.Length := vertexIdx + (LevelCount) * 2;
for i := 0 to LevelCount - 1 do begin
p1 := OuterSectionPoints[i * 2];
p2 := InnerSectionPoints[i * 2];
FData.VertexBuffer.Vertices[vertexIdx + i * 2 + 0] := p1;
FData.VertexBuffer.Vertices[vertexIdx + i * 2 + 1] := p2;
end;
indexIdx := FData.IndexBuffer.Length;
FData.IndexBuffer.Length := indexIdx + (LevelCount - 1) * 6;
for i := 0 to LevelCount - 2 do begin
vIdx := vertexIdx + i * 2 + 0;
FData.IndexBuffer[indexIdx + i * 6 + 0] := vIdx + 1;
FData.IndexBuffer[indexIdx + i * 6 + 1] := vIdx + 2;
FData.IndexBuffer[indexIdx + i * 6 + 2] := vIdx + 0;
FData.IndexBuffer[indexIdx + i * 6 + 3] := vIdx + 3;
FData.IndexBuffer[indexIdx + i * 6 + 4] := vIdx + 2;
FData.IndexBuffer[indexIdx + i * 6 + 5] := vIdx + 1;
end;
// right
vertexIdx := FData.VertexBuffer.Length;
FData.VertexBuffer.Length := vertexIdx + (LevelCount) * 2;
for i := 0 to LevelCount - 1 do begin
p1 := OuterSectionPoints[i * 2 + 1];
p2 := InnerSectionPoints[i * 2 + 1];
FData.VertexBuffer.Vertices[vertexIdx + i * 2 + 0] := p1;
FData.VertexBuffer.Vertices[vertexIdx + i * 2 + 1] := p2;
end;
indexIdx := FData.IndexBuffer.Length;
FData.IndexBuffer.Length := indexIdx + (LevelCount - 1) * 6;
for i := 0 to LevelCount - 2 do begin
vIdx := vertexIdx + i * 2 + 0;
FData.IndexBuffer[indexIdx + i * 6 + 0] := vIdx + 0;
FData.IndexBuffer[indexIdx + i * 6 + 1] := vIdx + 2;
FData.IndexBuffer[indexIdx + i * 6 + 2] := vIdx + 1;
FData.IndexBuffer[indexIdx + i * 6 + 3] := vIdx + 1;
FData.IndexBuffer[indexIdx + i * 6 + 4] := vIdx + 2;
FData.IndexBuffer[indexIdx + i * 6 + 5] := vIdx + 3;
end;
end;
procedure TPipe.ClearModifiers;
var
pModifier: TPipeModifier;
begin
for pModifier in Self.FModifiers do
pModifier.Free;
FModifiers.Clear;
end;
constructor TPipe.Create(AOwner: TComponent);
begin
inherited;
Self.TwoSide := True;
FModifiers := TList<TPipeModifier>.Create;
FModifiers.OnNotify := ModifiersNotify;
FOnZAxis := False;
FScaleBeforeRender := False;
RebuildMesh;
end;
destructor TPipe.Destroy;
begin
ClearModifiers;
FModifiers.Free;
inherited;
end;
function TPipe.FixHeight: Boolean;
begin
Result := False;
end;
procedure TPipe.GetAnnulusPointsForPosY(PosY: Single; var IPoints, OPoints: TPointArray);
var
i: Integer;
begin
SetLength(IPoints, Length(InnerPoints));
SetLength(OPoints, Length(OuterPoints));
for i := 0 to High(InnerPoints) do begin
IPoints[i] := Point3D(InnerPoints[i].X, PosY, InnerPoints[i].Z);
OPoints[i] := Point3D(OuterPoints[i].X, PosY, OuterPoints[i].Z);
end;
end;
procedure TPipe.ModifiersNotify(Sender: TObject; Const Item: TPipeModifier; Action: TCollectionNotification);
begin
SortModifiers;
RebuildMesh;
end;
procedure TPipe.RebuildMesh;
var
OuterSectionPoints, InnerSectionPoints: TPointArray;
InnerFirstPoints, InnerLastPoints, OuterFirstPoints, OuterLastPoints: TPointArray;
begin
if FModifiers = nil then
exit;
CalcPoints;
Data.VertexBuffer.Length := 0;
Data.IndexBuffer.Length := 0;
BuildCylinder(InnerPoints, True, InnerSectionPoints, InnerFirstPoints, InnerLastPoints);
BuildCylinder(OuterPoints, False, OuterSectionPoints, OuterFirstPoints, OuterLastPoints);
if FSectionType <> sctNone then
BuildSectionSurfaces(OuterSectionPoints, InnerSectionPoints);
BuildAnnulus(InnerLastPoints, OuterLastPoints, True);
BuildAnnulus(InnerFirstPoints, OuterFirstPoints, False);
Data.CalcFaceNormals;
end;
procedure TPipe.Render;
begin
if not FScaleBeforeRender then
Context.SetMatrix(TMatrix3D.CreateScaling(TPoint3D.Create(FRenderScale, 1, FRenderScale)) * AbsoluteMatrix);
Context.DrawTriangles(Data.VertexBuffer, Data.IndexBuffer, TMaterialSource.ValidMaterial(MaterialSource),
AbsoluteOpacity);
end;
procedure TPipe.SetHeight(const Value: Single);
var
FRefresh: Boolean;
begin
FRefresh := (Self.Height <> Value);
inherited;
if FRefresh then
RebuildMesh;
end;
procedure TPipe.SetOnZAxis(const Value: Boolean);
begin
FOnZAxis := Value;
RebuildMesh;
end;
procedure TPipe.SetScaleBeforeRender(const Value: Boolean);
begin
FScaleBeforeRender := Value;
RebuildMesh;
end;
function CompareLevels(Item1, Item2: TPipeModifier): Integer;
begin
Result := 0;
if TPipeModifier(Item1).StartPosition > TPipeModifier(Item2).StartPosition then begin
Result := 1;
end
else if TPipeModifier(Item1).StartPosition < TPipeModifier(Item2).StartPosition then begin
Result := -1;
end;
end;
procedure TPipe.SortModifiers;
var
Comparer: IComparer<TPipeModifier>;
begin
Comparer := TDelegatedComparer<TPipeModifier>.Create(
function(const Left, Right: TPipeModifier): Integer
begin
Result := Ceil(Left.StartPosition - Right.StartPosition);
if (Result = 0) and (Left is TTwistModifier) then
Result := 1;
end);
FModifiers.Sort(Comparer);
end;
{ TPipeModifier }
Function TPipeModifier.InsertPointLayer(StartLayer: TPointLayer; LayerH: Single; UseGap: Boolean = False): TPointLayer;
var
lParent: TPointLayer;
FLayer: TPointLayer;
begin
Result := nil;
FLayer := StartLayer;
repeat
if abs(LayerH - FLayer.LayerH) < 0.00001 then begin
Result := FLayer;
if UseGap then begin
Result := Result.CreateChildAtPosition(TPoint3D.Zero, 1);
Result.GapLayer := True;
end;
end
else if (FLayer.LayerH > LayerH) then begin
if assigned(FLayer.RealParent) then begin
lParent := FLayer.RealParent;
Result := lParent.CreateChildAtPosition(Point3D(0, LayerH - lParent.LayerH, 0), 1);
if UseGap then begin
Result := Result.CreateChildAtPosition(TPoint3D.Zero, 1);
Result.GapLayer := True;
end;
end;
end
else if (Result = nil) and (FLayer.RealChild = nil) then begin
Result := FLayer.CreateChildAtPosition(Point3D(0, LayerH - FLayer.LayerH, 0), 1);
if UseGap then begin
Result := Result.CreateChildAtPosition(TPoint3D.Zero, 1);
Result.GapLayer := True;
end;
end;
FLayer := FLayer.RealChild;
until (Result <> nil) or (FLayer = nil);
end;
procedure TPipeModifier.BeginModify(StartPoints: TPointLayer);
var
i: Integer;
FLayer: TPointLayer;
mLen, dLen: Single;
h1, h2, dh: Single;
sCnt: Integer;
tempList: TList<TPointLayer>;
divCount: Integer;
begin
StartLayer := InsertPointLayer(StartPoints, FStartPosition, FUseGap);
EndLayer := InsertPointLayer(StartPoints, FEndPosition, FUseGap);
StartMLayer := nil;
EndMLayer := nil;
divCount := (FSubdivisions + 1);
if (FStartMargin > 0) then begin
StartMLayer := InsertPointLayer(StartPoints, FStartPosition + FStartMargin);
divCount := divCount - 1;
end;
if (FEndMargin > 0) then begin
EndMLayer := InsertPointLayer(StartPoints, FEndPosition - FEndMargin);
divCount := divCount - 1;
end;
mLen := Self.EndPosition - Self.StartPosition - (FEndMargin + FStartMargin);
dLen := mLen / divCount;
if assigned(StartLayer) and assigned(EndLayer) then begin
tempList := TList<TPointLayer>.Create;
FLayer := StartLayer;
if assigned(StartMLayer) then
FLayer := StartMLayer;
repeat
tempList.Add(FLayer);
FLayer := FLayer.RealChild;
until (FLayer = EndLayer) or (FLayer = EndMLayer);
if assigned(FLayer) then
tempList.Add(FLayer);
for i := 0 to tempList.Count - 2 do begin
h1 := tempList[i].LayerH;
h2 := tempList[i + 1].LayerH;
sCnt := Round((h2 - h1) / dLen);
if sCnt > 1 then begin
dh := (h2 - h1) / sCnt;
tempList[i].CreateChildAtPosition(Point3D(0, dh, 0), sCnt - 1);
end;
end;
FLayerCount := EndLayer.Index - StartLayer.Index + 1;
tempList.Free;
end;
end;
constructor TPipeModifier.Create(aPipe: TPipe);
begin
inherited Create(aPipe);
FPipe := aPipe;
FSubdivisions := 10;
FStartPosition := -FPipe.Height / 4;
FEndPosition := FPipe.Height / 4;
FStartMargin := 0;
FEndMargin := 0;
FModifyMargins := False;
end;
procedure TPipeModifier.DoModify(StartPoints: TPointLayer);
var
FLayer: TPointLayer;
begin
if (FStartPosition > FEndPosition) then
exit;
if (FStartPosition = FEndPosition) then
exit;
BeginModify(StartPoints);
if (not assigned(StartLayer)) or (not assigned(EndLayer)) then
raise Exception.Create('Modifier Position Indexes cant be arranged');
FLayer := StartLayer;
if (not FModifyMargins) and assigned(StartMLayer) then
FLayer := StartMLayer;
Self.ModifySubPoints(FLayer, False);
repeat
FLayer := FLayer.RealChild;
if assigned(FLayer) then
Self.ModifySubPoints(FLayer, False);
until (FLayer = nil) or ((FLayer = EndMLayer) and (not FModifyMargins)) or (FLayer = EndLayer);
end;
procedure TPipeModifier.EndModify;
begin
if assigned(StartLayer) then
FFirstCenter := StartLayer.AbsoluteCenter;
if assigned(EndLayer) then
FLastCenter := EndLayer.AbsoluteCenter;
end;
procedure TPipeModifier.SetEndPosition(const Value: Single);
begin
FEndPosition := Value;
FPipe.RebuildMesh;
end;
procedure TPipeModifier.SetModifyMargins(const Value: Boolean);
begin
FModifyMargins := Value;
FPipe.RebuildMesh;
end;
procedure TPipeModifier.SetStartPosition(const Value: Single);
begin
FStartPosition := Value;
FPipe.RebuildMesh;
end;
procedure TPipeModifier.SetSubdivisions(const Value: Integer);
begin
FSubdivisions := Value;
FPipe.RebuildMesh;
end;
{ TBendModifier }
constructor TBendModifier.Create(aPipe: TPipe);
begin
inherited;
FEndPosition := FPipe.Height / 4;
FBendAngle := 90;
FTurnAngle := 0;
end;
destructor TBendModifier.Destroy;
begin
inherited;
end;
procedure TBendModifier.ModifySubPoints(sPoints: TPointLayer; isInner: Boolean);
var
Index: Integer;
FCurrentBendAngle: Single;
begin
FCurrentBendAngle := (FBendAngle / (FLayerCount - 1));
Index := sPoints.Index;
if sPoints = StartLayer then begin
sPoints.DummyChild.RotationAngle.Z := FCurrentBendAngle / 2;
sPoints.RotationAngle.Y := FTurnAngle;
end
else if (Index > StartLayer.Index) and (Index <= EndLayer.Index) then begin
sPoints.RotationAngle.Z := FCurrentBendAngle / 2;
if sPoints <> EndLayer then begin
sPoints.DummyChild.RotationAngle.Z := FCurrentBendAngle / 2;
end;
end;
end;
procedure TBendModifier.SetBendAngle(const Value: Single);
begin
FBendAngle := Value;
FPipe.RebuildMesh;
end;
procedure TBendModifier.SetTurnAngle(const Value: Single);
begin
FTurnAngle := Value;
FPipe.RebuildMesh;
end;
{ TTwistModifier }
constructor TTwistModifier.Create(aPipe: TPipe);
begin
inherited;
FTotalRotation := 45;
end;
procedure TTwistModifier.ModifySubPoints(sPoints: TPointLayer; isInner: Boolean);
var
ya: Single;
totalH, thisH: Single;
cIndex, sIndex, eIndex: Integer;
begin
sIndex := StartLayer.Index;
cIndex := sPoints.Index;
eIndex := EndLayer.Index;
if (cIndex > sIndex) and (cIndex <= eIndex) then begin
totalH := FEndPosition - FStartPosition;
thisH := sPoints.GetLayerH - FStartPosition;
ya := (FTotalRotation / totalH) * thisH;
sPoints.Content.RotationAngle.Y := ya;
end;
end;
procedure TTwistModifier.SetTotalRotation(const Value: Single);
begin
FTotalRotation := Value;
FPipe.RebuildMesh;
end;
{ TPointLayer }
function TPointLayer.AbsPoint(i: Integer): TPoint3d;
var
tTurn: Single;
begin
tTurn := GetTotalTurn;
FContent.FContent.RotationAngle.Y := -tTurn;
Result := Points[i] * FContent.FContent.AbsoluteMatrix;
end;
procedure TPointLayer.AddChild(CPointLayer: TPointLayer);
var
FOldChild: TPointLayer;
begin
FOldChild := FChild.FChild;
Self.FChild.FChild := CPointLayer;
CPointLayer.FParent := Self.FChild;
if assigned(FOldChild) then begin
CPointLayer.LastChild.AddChild(FOldChild);
end;
end;
function TPointLayer.Content: TPointLayer;
begin
Result := FContent;
end;
constructor TPointLayer.Create;
begin
inherited;
FLocalMatrix := TMatrix3D.Identity;
FQuaternion := TQuaternion3D.Identity;
FPosition := TPosition3d.Create(TPoint3D.Zero);
FPosition.OnChange := MatrixChanged;
FRotationAngle := TPosition3d.Create(TPoint3D.Zero);
FRotationAngle.OnChange := RotationChanged;
FScale := TPosition3d.Create(Point3D(1, 1, 1));
FScale.OnChange := MatrixChanged;
FAbsMatrixNeedRefresh := True;
FGapLayer := False;
CreateDummies;
end;
function TPointLayer.CreateChildAtPosition(CPos: TPoint3d; RepeatNbr: Integer): TPointLayer;
var
i: Integer;
begin
Result := TPointLayer.Create;
Result.Length := Self.Length;
for i := 0 to Length - 1 do
Result.Points[i] := Self.Points[i];
Result.Position.point := CPos;
if assigned(FChild.FChild) then begin
FChild.FChild.Position.point := FChild.FChild.Position.point - CPos;
end;
Self.AddChild(Result);
RepeatNbr := RepeatNbr - 1;
if RepeatNbr > 0 then
Result := Result.CreateChildAtPosition(CPos, RepeatNbr);
end;
procedure TPointLayer.CreateDummies;
var
FContentContent: TPointLayer;
begin
FChild := TDummyPointLayer.Create;
FChild.FParent := Self;
FContent := TDummyPointLayer.Create;
FContent.FParent := Self;
FContentContent := TDummyPointLayer.Create;
FContentContent.FParent := FContent;
FContent.FContent := FContentContent;
end;
destructor TPointLayer.Destroy;
begin
FreeAndNil(FChild);
FreeAndNil(FRotationAngle);
FreeAndNil(FScale);
FreeAndNil(FPosition);
FreeAndNil(FContent);
inherited;
end;
function TPointLayer.GeAbsoluteCenter: TPoint3d;
var
tTurn: Single;
begin
tTurn := GetTotalTurn;
FContent.FContent.RotationAngle.Y := -tTurn;
Result := TPoint3D.Zero * FContent.FContent.AbsoluteMatrix;
end;
function TPointLayer.GetAbsoluteMatrix: TMatrix3D;
begin
if not FAbsMatrixNeedRefresh then begin
Result := FSavedAbsoluteMatrix;
end
else begin
if assigned(FParent) and (FParent is TPointLayer) then
Result := FLocalMatrix * TPointLayer(FParent).AbsoluteMatrix
else
Result := FLocalMatrix;
FSavedAbsoluteMatrix := Result;
FAbsMatrixNeedRefresh := False;
end;
end;
function TPointLayer.GetDummyChild: TPointLayer;
begin
result := nil;
if assigned(FChild) and (FChild is TDummyPointLayer) then
Result := FChild;
end;
function TPointLayer.GetFirstParent: TPointLayer;
begin
Result := Self;
if assigned(FParent.FParent) then begin
Result := FParent.FParent.FirstParent;
end;
end;
function TPointLayer.GetLayer(LIndex: Integer): TPointLayer;
begin
if LIndex = 0 then
Result := Self
else if assigned(FChild.FChild) and (LIndex > 0) then begin
Result := FChild.FChild.GetLayer(LIndex - 1);
end
else
Result := nil;
end;
function TPointLayer.GetLayerCount: Integer;
begin
Result := 1;
if assigned(FChild.FChild) then
Result := 1 + FChild.FChild.LayerCount;
end;
function TPointLayer.GetLayerH: Single;
begin
Result := Self.Position.Y;
if assigned(RealParent) then
Result := Result + RealParent.GetLayerH;
end;
function TPointLayer.GetLength: Integer;
begin
Result := System.Length(Points);
end;
function TPointLayer.GetRealChild: TPointLayer;
begin
Result := FChild.FChild;
end;
function TPointLayer.GetRealParent: TPointLayer;
begin
Result := nil;
if assigned(FParent) then
Result := FParent.FParent;
end;
function TPointLayer.GetTotalTurn: Single;
begin
Result := RotationAngle.Y;
if assigned(FParent) then
Result := Result + FParent.GetTotalTurn;
end;
function TPointLayer.Index: Integer;
begin
Result := 0;
if assigned(FParent) and assigned(FParent.FParent) then
Result := 1 + FParent.FParent.Index;
end;
procedure TPointLayer.InvalidateAbsoluteMatrix;
begin
FAbsMatrixNeedRefresh := True;
if assigned(FChild) then
FChild.InvalidateAbsoluteMatrix;
end;
function TPointLayer.LastChild: TPointLayer;
begin
Result := Self;
if assigned(FChild.FChild) then
Result := FChild.FChild.LastChild;
end;
procedure TPointLayer.MatrixChanged(Sender: TObject);
var
LeftVector, DirectionVector, UpVector: TPoint3d;
RotMatrix: TMatrix3D;
begin
UpVector := Point3d(0, 1, 0);
DirectionVector := Point3d(0, 0, 1);
if (FRotationAngle.X <> 0) or (FRotationAngle.Y <> 0) or (FRotationAngle.Z <> 0) then begin
RotMatrix := FQuaternion;
UpVector := UpVector * RotMatrix;
DirectionVector := DirectionVector * RotMatrix;
end
else begin
FQuaternion := TQuaternion3D.Identity;
end;
LeftVector := UpVector.CrossProduct(DirectionVector);
FLocalMatrix.M[0] := LeftVector * FScale.X;
FLocalMatrix.m14 := 0;
FLocalMatrix.M[1] := UpVector * FScale.Y;
FLocalMatrix.m24 := 0;
FLocalMatrix.M[2] := DirectionVector * FScale.Z;
FLocalMatrix.m34 := 0;
FLocalMatrix.m41 := FPosition.X;
FLocalMatrix.m42 := FPosition.Y;
FLocalMatrix.m43 := FPosition.Z;
FAbsMatrixNeedRefresh := True;
end;
Function TPointLayer.RemoveFirstChild: TPointLayer;
begin
result := nil;
if assigned(FChild.FChild) then begin
Result := FChild.FChild;
FChild.FChild := nil;
if assigned(Result.FChild.FChild) then begin
Self.AddChild(Result.FChild.FChild);
Result.FChild.FChild := nil;
end;
end;
end;
procedure TPointLayer.RotationChanged(Sender: TObject);
var
q: TQuaternion3D;
A: Single;
begin
FQuaternion := TQuaternion3D.Identity;
A := DegToRad(DegNormalize(RotationAngle.X));
if A <> 0 then begin
{ AbsoluteRight }
q := TQuaternion3D.Create(Point3D(1, 0, 0), A);
FQuaternion := FQuaternion * q;
end;
A := DegToRad(DegNormalize(RotationAngle.Y));
if A <> 0 then begin
{ AbsoluteDirection }
q := TQuaternion3D.Create(Point3D(0, 1, 0), A);
FQuaternion := FQuaternion * q;
end;
A := DegToRad(DegNormalize(RotationAngle.Z));
if A <> 0 then begin
{ AbsoluteUp }
q := TQuaternion3D.Create(Point3D(0, 0, 1), A);
FQuaternion := FQuaternion * q;
end;
MatrixChanged(Sender);
end;
procedure TPointLayer.SetPointsLength(const Value: Integer);
begin
SetLength(Points, Value);
end;
{ TEmbossModifier }
constructor TEmbossModifier.Create(aPipe: TPipe);
begin
inherited;
FStartMargin := 0.02;
FEndMargin := 0.02;
FThicknessRatio := 0.1;
end;
procedure TEmbossModifier.ModifySubPoints(sPoints: TPointLayer; isInner: Boolean);
begin
sPoints.Content.Scale.point := Point3D(1 + FThicknessRatio, 0, 1 + FThicknessRatio);
end;
procedure TEmbossModifier.SetThicknessRatio(const Value: Single);
begin
FThicknessRatio := Value;
FPipe.RebuildMesh;
end;
{ TDummyPointLayer }
procedure TDummyPointLayer.CreateDummies;
begin
// Do Nothing
end;
{ TBreakModifier }
constructor TBreakModifier.Create(aPipe: TPipe);
begin
inherited;
FModifyMargins := True;
end;
procedure TBreakModifier.ModifySubPoints(sPoints: TPointLayer; isInner: Boolean);
var
Index: Integer;
FCurrentBendAngle: Single;
elpR: Single;
begin
FCurrentBendAngle := (FBendAngle / (FLayerCount - 2));
FCurrentBendAngle := FCurrentBendAngle / 2;
elpR := 1 / cos((FCurrentBendAngle) * (pi / 180));
Index := sPoints.Index;
if (Index > StartLayer.Index) and (Index < EndLayer.Index) then begin
sPoints.RotationAngle.Z := FCurrentBendAngle;
sPoints.Content.Scale.point := Point3D(elpR, 1, 1);
sPoints.DummyChild.RotationAngle.Z := FCurrentBendAngle;
end;
end;
procedure TBreakModifier.SetEndMargin(const Value: Single);
begin
FEndMargin := Value;
FPipe.RebuildMesh;
end;
procedure TBreakModifier.SetStartMargin(const Value: Single);
begin
FStartMargin := Value;
FPipe.RebuildMesh;
end;
initialization
RegisterFmxClasses([TPipeModifier, TBendModifier, TTwistModifier, TEmbossModifier]);
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment