Luxophia

Форк
0
/
LUX.Brep.Cell.TetraFlip.D3.FMX.pas 
341 строка · 11.2 Кб
1
unit LUX.Brep.Cell.TetraFlip.D3.FMX;
2

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

5
uses System.Classes, System.Math.Vectors,
6
     FMX.Types, FMX.Types3D, FMX.Controls3D, FMX.MaterialSources,
7
     LUX, LUX.D3, LUX.Geometry.D3, LUX.Brep.Cell.TetraFlip, LUX.Brep.Cell.TetraFlip.D3;
8

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

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

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

15
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TEdges
16

17
     TEdges = class( TControl3D )
18
     private
19
     protected
20
       _Geometry   :TMeshData;
21
       _Material   :TMaterialSource;
22
       _TetraModel :TTetraModel3D;
23
       _EdgeRadius :Single;
24
       ///// アクセス
25
       procedure SetTetraModel( const TetraModel_:TTetraModel3D );
26
       procedure SetEdgeRadius( const EdgeRadius_:Single );
27
       ///// メソッド
28
       procedure Render; override;
29
       procedure MakeMesh( const Ps_:array of TSingle3D );
30
     public
31
       constructor Create( AOwner_:TComponent ); override;
32
       destructor Destroy; override;
33
       ///// プロパティ
34
       property Geometry   :TMeshData       read _Geometry                      ;
35
       property Material   :TMaterialSource read _Material   write _Material    ;
36
       property TetraModel :TTetraModel3D   read _TetraModel write SetTetraModel;
37
       property EdgeRadius :Single          read _EdgeRadius write SetEdgeRadius;
38
       ///// メソッド
39
       procedure MakeModel; virtual; abstract;
40
     end;
41

42
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TDelaEdges
43

44
     TDelaEdges = class( TEdges )
45
     private
46
     protected
47
     public
48
       ///// メソッド
49
       procedure MakeModel; override;
50
     end;
51

52
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TVoroEdges
53

54
     TVoroEdges = class( TEdges )
55
     private
56
     protected
57
       _EdgeLength :Single;
58
       ///// アクセス
59
       procedure SetEdgeLength( const EdgeLength_:Single );
60
     public
61
       constructor Create( AOwner_:TComponent ); override;
62
       ///// プロパティ
63
       property EdgeLength :Single read _EdgeLength write SetEdgeLength;
64
       ///// メソッド
65
       procedure MakeModel; override;
66
     end;
67

68
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
69

70
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
71

72
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
73

74
implementation //############################################################### ■
75

76
uses System.SysUtils, System.RTLConsts;
77

78
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
79

80
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
81

82
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TEdges
83

84
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
85

86
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
87

88
/////////////////////////////////////////////////////////////////////// アクセス
89

90
procedure TEdges.SetTetraModel( const TetraModel_:TTetraModel3D );
91
begin
92
     _TetraModel := TetraModel_;  MakeModel;
93
end;
94

95
procedure TEdges.SetEdgeRadius( const EdgeRadius_:Single );
96
begin
97
     _EdgeRadius := EdgeRadius_;  MakeModel;
98
end;
99

100
/////////////////////////////////////////////////////////////////////// メソッド
101

102
procedure TEdges.Render;
103
begin
104
     Context.SetMatrix( AbsoluteMatrix );
105

106
     _Geometry.Render( Context, TMaterialSource.ValidMaterial( _Material ), AbsoluteOpacity );
107
end;
108

109
procedure TEdges.MakeMesh( const Ps_:array of TSingle3D );
110
var
111
   N, I :Integer;
112
begin
113
     N := Length( Ps_ );
114

115
     with _Geometry do
116
     begin
117
          with VertexBuffer do
118
          begin
119
               Length := N;
120

121
               for I := 0 to Length-1 do Vertices[ I ] := Ps_[ I ];
122
          end;
123

124
          with IndexBuffer do
125
          begin
126
               Length := N;
127

128
               for I := 0 to Length-1 do Indices[ I ] := I;
129
          end;
130

131
          CalcFaceNormals;
132
     end;
133
end;
134

135
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
136

137
constructor TEdges.Create( AOwner_:TComponent );
138
begin
139
     inherited;
140

141
     HitTest := False;
142

143
     _Geometry := TMeshData.Create;
144
end;
145

146
destructor TEdges.Destroy;
147
begin
148
     _Geometry.Free;
149

150
     inherited;
151
end;
152

153
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TDelaEdges
154

155
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
156

157
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
158

159
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
160

161
/////////////////////////////////////////////////////////////////////// メソッド
162

163
procedure TDelaEdges.MakeModel;
164
var
165
   Ps :array of TSingle3D;
166
   I0, K :Integer;
167
   C0, C1 :TTetraCell3D;
168
   T0 :record
169
         P0, P1, P2, P3,
170
         C102, C203, P301,
171
         C021, C032, C013,
172
         C312, C123, C231 :TSingle3D;
173
       end;
174
begin
175
     Ps := [];
176

177
     for I0 := 0 to _TetraModel.ChildsN-1 do
178
     begin
179
          C0 := _TetraModel[ I0 ];
180

181
          if C0.Open < 0 then
182
          begin
183
               for K := 0 to 3 do
184
               begin
185
                    with _VertTable[ K ] do
186
                    begin
187
                         T0.P0 := C0.Poin[ _[ 0 ] ].Pos;
188
                         T0.P1 := C0.Poin[ _[ 1 ] ].Pos;
189
                         T0.P2 := C0.Poin[ _[ 2 ] ].Pos;
190
                         T0.P3 := C0.Poin[ _[ 3 ] ].Pos;
191
                    end;
192

193
                    T0.C102 := MarginCorner( T0.P0, T0.P1, T0.P2, _EdgeRadius );
194
                    T0.C203 := MarginCorner( T0.P0, T0.P2, T0.P3, _EdgeRadius );
195
                    T0.P301 := MarginCorner( T0.P0, T0.P3, T0.P1, _EdgeRadius );
196

197
                    T0.C021 := MarginCorner( T0.P2, T0.P0, T0.P1, _EdgeRadius );
198
                    T0.C032 := MarginCorner( T0.P3, T0.P0, T0.P2, _EdgeRadius );
199
                    T0.C013 := MarginCorner( T0.P1, T0.P0, T0.P3, _EdgeRadius );
200

201
                    Ps := Ps + [ T0.C021, T0.C102, T0.C203,
202
                                 T0.C032, T0.C203, T0.P301,
203
                                 T0.C013, T0.P301, T0.C102,
204
                                 T0.C102, T0.P301, T0.C203 ];
205

206
                    C1 := C0.Cell[ K ];
207

208
                    if not ( Assigned( C1 ) and Assigned( C1.Poin[ C0.Vert[ K ] ] ) ) then
209
                    begin
210
                         T0.C312 := MarginCorner( T0.P1, T0.P3, T0.P2, _EdgeRadius );
211
                         T0.C123 := MarginCorner( T0.P2, T0.P1, T0.P3, _EdgeRadius );
212
                         T0.C231 := MarginCorner( T0.P3, T0.P2, T0.P1, _EdgeRadius );
213

214
                         Ps := Ps + [ T0.P2  , T0.P1  , T0.C312,
215
                                      T0.C312, T0.C123, T0.P2  ,
216
                                      T0.P3  , T0.P2  , T0.C123,
217
                                      T0.C123, T0.C231, T0.P3  ,
218
                                      T0.P1  , T0.P3  , T0.C231,
219
                                      T0.C231, T0.C312, T0.P1   ];
220
                    end;
221
               end;
222
          end;
223
     end;
224

225
     MakeMesh( Ps );
226
end;
227

228
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TVoroEdges
229

230
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
231

232
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
233

234
/////////////////////////////////////////////////////////////////////// アクセス
235

236
procedure TVoroEdges.SetEdgeLength( const EdgeLength_:Single );
237
begin
238
     _EdgeLength := EdgeLength_;  MakeModel;
239
end;
240

241
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
242

243
constructor TVoroEdges.Create( AOwner_:TComponent );
244
begin
245
     inherited;
246

247
     _EdgeLength := 10;
248
end;
249

250
/////////////////////////////////////////////////////////////////////// メソッド
251

252
procedure TVoroEdges.MakeModel;
253
var
254
   Ps :array of TSingle3D;
255
   I0, K :Integer;
256
   C0, C1 :TTetraCell3D;
257
   T0 :record
258
         S,
259
         V0, V1, V2, V3,
260
         C01, C02, C03,
261
         C23, C31, C13 :TSingle3D;
262
       end;
263
   T1 :record
264
         S,
265
         V0, V1, V2, V3,
266
         C01, C02, C03 :TSingle3D;
267
       end;
268
begin
269
     Ps := [];
270

271
     for I0 := 0 to _TetraModel.ChildsN-1 do
272
     begin
273
          C0 := _TetraModel[ I0 ];
274

275
          if C0.Open < 0 then
276
          begin
277
               T0.S := C0.CircumCenter;
278

279
               for K := 0 to 3 do
280
               begin
281
                    with _VertTable[ K ] do
282
                    begin
283
                         T0.V0 := C0.VoroEdge[ _[ 0 ] ];
284
                         T0.V1 := C0.VoroEdge[ _[ 1 ] ];
285
                         T0.V2 := C0.VoroEdge[ _[ 2 ] ];
286
                         T0.V3 := C0.VoroEdge[ _[ 3 ] ];
287
                    end;
288

289
                    T0.C23 := T0.S + MarginCorner( T0.V2, T0.V3, _EdgeRadius );
290
                    T0.C31 := T0.S + MarginCorner( T0.V3, T0.V1, _EdgeRadius );
291
                    T0.C13 := T0.S + MarginCorner( T0.V1, T0.V2, _EdgeRadius );
292

293
                    Ps := Ps + [ T0.C23, T0.C31, T0.C13 ];
294

295
                    T0.C01 := T0.S + MarginCorner( T0.V0, T0.V1, _EdgeRadius );
296
                    T0.C02 := T0.S + MarginCorner( T0.V0, T0.V2, _EdgeRadius );
297
                    T0.C03 := T0.S + MarginCorner( T0.V0, T0.V3, _EdgeRadius );
298

299
                    C1 := C0.Cell[ K ];
300

301
                    if Assigned( C1 ) and Assigned( C1.Poin[ C0.Vert[ K ] ] ) then
302
                    begin
303
                         T1.S := C1.CircumCenter;
304

305
                         T1.V0 := C1.VoroEdge[ C0.Join[ K, 0 ] ];
306
                         T1.V1 := C1.VoroEdge[ C0.Join[ K, 1 ] ];
307
                         T1.V2 := C1.VoroEdge[ C0.Join[ K, 2 ] ];
308
                         T1.V3 := C1.VoroEdge[ C0.Join[ K, 3 ] ];
309

310
                         T1.C01 := T1.S + MarginCorner( T1.V0, T1.V1, _EdgeRadius );
311
                         T1.C02 := T1.S + MarginCorner( T1.V0, T1.V2, _EdgeRadius );
312
                         T1.C03 := T1.S + MarginCorner( T1.V0, T1.V3, _EdgeRadius );
313

314
                         Ps := Ps + [ T1.C01, T0.C01, T0.C03,
315
                                      T1.C02, T0.C02, T0.C01,
316
                                      T1.C03, T0.C03, T0.C02 ];
317
                    end
318
                    else
319
                    begin
320
                         T1.S := T0.S + _EdgeLength * T0.V0;
321

322
                         Ps := Ps + [ T1.S, T0.C01, T0.C03,
323
                                      T1.S, T0.C02, T0.C01,
324
                                      T1.S, T0.C03, T0.C02 ];
325
                    end;
326
               end;
327
          end;
328
     end;
329

330
     MakeMesh( Ps );
331
end;
332

333
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
334

335
//############################################################################## □
336

337
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
338

339
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
340

341
end. //######################################################################### ■
342

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.