Luxophia

1
unit LUX.FMX.Objects3D;
2

3
interface //#################################################################### ■
4

5
uses System.Types, System.Classes, System.Math.Vectors,
6
     FMX.Types3D, FMX.Controls3D, FMX.MaterialSources,
7
     LUX;
8

9
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
10

11
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
12

13
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
14

15
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTwistRod
16

17
     TTwistRod = class( TControl3D )
18
     private
19
       ///// メソッド
20
       function XYtoI( const X_,Y_:Integer ) :Integer; inline;
21
       procedure MakeModel;
22
     protected
23
       _Geometry :TMeshData;
24
       _Material :TMaterialSource;
25
       _Radius   :Single;
26
       _DivH     :Integer;
27
       _DivR     :Integer;
28
       _AngleT   :Single;
29
       _AngleB   :Single;
30
       ///// アクセス
31
       procedure SetHeight( const Radius_:Single ); override;
32
       procedure SetRadius( const Radius_:Single ); virtual;
33
       procedure SetDivH( const DivH_:Integer ); virtual;
34
       procedure SetDivR( const DivR_:Integer ); virtual;
35
       procedure SetAngleT( const AngleT_:Single ); virtual;
36
       procedure SetAngleB( const AngleB_:Single ); virtual;
37
       ///// メソッド
38
       procedure Render; override;
39
     public
40
       constructor Create( Owner_:TComponent ); override;
41
       destructor Destroy; override;
42
       ///// プロパティ
43
       property Material :TMaterialSource read _Material write   _Material;
44
       property Radius   :Single          read _Radius   write SetRadius  ;
45
       property DivH     :Integer         read _DivH     write SetDivH    ;
46
       property DivR     :Integer         read _DivR     write SetDivR    ;
47
       property AngleT   :Single          read _AngleT   write SetAngleT  ;
48
       property AngleB   :Single          read _AngleB   write SetAngleB  ;
49
     end;
50

51
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
52

53
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
54

55
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
56

57
implementation //############################################################### ■
58

59
uses System.SysUtils, System.RTLConsts, System.Math;
60

61
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
62

63
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
64

65
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TTwistRod
66

67
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
68

69
function TTwistRod.XYtoI( const X_,Y_:Integer ) :Integer;
70
begin
71
     Result := ( _DivR + 1 ) * Y_ + X_;
72
end;
73

74
procedure TTwistRod.MakeModel;
75
var
76
   X ,Y, I :Integer;
77
   T :TPointF;
78
   N, P :TPoint3D;
79
   S, B, R, A :Single;
80
begin
81
     with _Geometry do
82
     begin
83
          with VertexBuffer do
84
          begin
85
               Length := ( _DivR + 1 ) * ( _DivH + 1 );
86

87
               for Y := 0 to _DivH do
88
               begin
89
                    T.Y := Y / _DivH;
90

91
                    N.Y := 0;
92
                    P.Y := Height * ( T.Y - 0.5 );
93

94
                    S := ( 1 - Cos( Pi * T.Y ) ) / 2;
95

96
                    B := ( _AngleB - _AngleT ) * S + _AngleT;
97

98
                    R := _Radius;
99

100
                    for X := 0 to _DivR do
101
                    begin
102
                         T.X := X / _DivR;
103

104
                         A := B + Pi2 * T.X;
105

106
                         N.X := Cos( A );
107
                         N.Z := Sin( A );
108

109
                         P.X := R * N.X;
110
                         P.Z := R * N.Z;
111

112
                         I := XYtoI( X, Y );
113

114
                         Vertices [ I ] := P;
115
                         Normals  [ I ] := N;
116
                         TexCoord0[ I ] := T;
117
                    end;
118
               end;
119
          end;
120

121
          with IndexBuffer do
122
          begin
123
               Length := 3{Poin} * 2{Face} * _DivR * _DivH;
124

125
               I := 0;
126
               for Y := 0 to _DivH-1 do
127
               begin
128
                    for X := 0 to _DivR-1 do
129
                    begin
130
                         //    X0      X1
131
                         //  Y0┼───┼
132
                         //    │＼    │
133
                         //    │  ＼  │
134
                         //    │    ＼│
135
                         //  Y1┼───┼
136

137
                         Indices[ I ] := XYtoI( X  , Y   );  Inc( I );
138
                         Indices[ I ] := XYtoI( X+1, Y   );  Inc( I );
139
                         Indices[ I ] := XYtoI( X+1, Y+1 );  Inc( I );
140

141
                         Indices[ I ] := XYtoI( X+1, Y+1 );  Inc( I );
142
                         Indices[ I ] := XYtoI( X  , Y+1 );  Inc( I );
143
                         Indices[ I ] := XYtoI( X  , Y   );  Inc( I );
144
                    end;
145
               end;
146
          end;
147
     end;
148
end;
149

150
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
151

152
/////////////////////////////////////////////////////////////////////// アクセス
153

154
procedure TTwistRod.SetHeight( const Radius_:Single );
155
begin
156
     inherited;
157

158
     MakeModel;
159
end;
160

161
procedure TTwistRod.SetRadius( const Radius_:Single );
162
begin
163
     _Radius := Radius_;  MakeModel;
164
end;
165

166
procedure TTwistRod.SetDivH( const DivH_:Integer );
167
begin
168
     _DivH := DivH_;  MakeModel;
169
end;
170
procedure TTwistRod.SetDivR( const DivR_:Integer );
171
begin
172
     _DivR := DivR_;  MakeModel;
173
end;
174

175
procedure TTwistRod.SetAngleT( const AngleT_:Single );
176
begin
177
     _AngleT := AngleT_;  MakeModel;
178
end;
179

180
procedure TTwistRod.SetAngleB( const AngleB_:Single );
181
begin
182
     _AngleB := AngleB_;  MakeModel;
183
end;
184

185
/////////////////////////////////////////////////////////////////////// メソッド
186

187
procedure TTwistRod.Render;
188
begin
189
     Context.SetMatrix( AbsoluteMatrix);
190

191
     _Geometry.Render( Context, TMaterialSource.ValidMaterial(_Material), AbsoluteOpacity );
192
end;
193

194
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
195

196
constructor TTwistRod.Create( Owner_:TComponent );
197
begin
198
     inherited;
199

200
     _Geometry := TMeshData.Create;
201

202
     FHeight := 3;
203
     _Radius := 1;
204
     _DivH   := 10;
205
     _DivR   := 36;
206
     _AngleT := 0;
207
     _AngleB := 0;
208

209
     MakeModel;
210
end;
211

212
destructor TTwistRod.Destroy;
213
begin
214
     _Geometry.Free;
215

216
     inherited;
217
end;
218

219
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
220

221
//############################################################################## □
222

223
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
224

225
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
226

227
end. //######################################################################### ■
228