Luxophia

LUX.Data.Lattice.T2.pas
465 строк · 15.7 Кб
Перенос по словам
1
unit LUX.Data.Lattice.T2;
2

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

5
uses LUX;
6

7
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
8

9
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
10

11
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
12

13
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TArray2D<_TItem_>
14

15
     IArray2D = interface
16
     ['{E4ECF85C-317F-4179-BDAE-C4495D2B2CC7}']
17
     {protected}
18
       ///// アクセス
19
       function GetItemByte :Integer;
20
       function GetElemsP0 :Pointer;
21
       function GetElemsX :Integer;
22
       function GetElemsY :Integer;
23
       function GetElemsN :Integer;
24
       function GetElemsByte :Integer;
25
       function GetItemsX :Integer;
26
       procedure SetItemsX( const ItemsX_:Integer );
27
       function GetItemsY :Integer;
28
       procedure SetItemsY( const ItemsY_:Integer );
29
       function GetMargsX :Integer;
30
       procedure SetMargsX( const MargsX_:Integer );
31
       function GetMargsY :Integer;
32
       procedure SetMargsY( const MargsY_:Integer );
33
     {public}
34
       ///// プロパティ
35
       property ItemByte  :Integer read GetItemByte                 ;
36
       property ElemsP0   :Pointer read GetElemsP0                  ;
37
       property ElemsX    :Integer read GetElemsX                   ;
38
       property ElemsY    :Integer read GetElemsY                   ;
39
       property ElemsN    :Integer read GetElemsN                   ;
40
       property ElemsByte :Integer read GetElemsByte                ;
41
       property ItemsX    :Integer read GetItemsX    write SetItemsX;
42
       property ItemsY    :Integer read GetItemsY    write SetItemsY;
43
       property MargsX    :Integer read GetMargsX    write SetMargsX;
44
       property MargsY    :Integer read GetMargsY    write SetMargsY;
45
     end;
46

47
     //-------------------------------------------------------------------------
48

49
     TArray2D<_TItem_> = class( TInterfacedBase, IArray2D )
50
     public type
51
       _PItem_ = ^_TItem_;
52
     private
53
       ///// メソッド
54
       procedure MakeArray;
55
       function XYtoI( const X_,Y_:Integer ) :Integer; inline;
56
     protected
57
       _Elems  :TArray<_TItem_>;
58
       _ElemsX :Integer;
59
       _ElemsY :Integer;
60
       _ItemsX :Integer;
61
       _ItemsY :Integer;
62
       _MargsX :Integer;
63
       _MargsY :Integer;
64
       ///// アクセス
65
       function GetItemByte :Integer;
66
       function GetElemsP0 :Pointer;
67
       function GetElemsX :Integer;
68
       function GetElemsY :Integer;
69
       function GetElemsN :Integer;
70
       function GetElemsByte :Integer;
71
       function GetItems( const X_,Y_:Integer ) :_TItem_;
72
       procedure SetItems( const X_,Y_:Integer; const Item_:_TItem_ );
73
       function GetItemP( const X_,Y_:Integer ) :_PItem_;
74
       function GetItemsX :Integer;
75
       procedure SetItemsX( const ItemsX_:Integer );
76
       function GetItemsY :Integer;
77
       procedure SetItemsY( const ItemsY_:Integer );
78
       function GetMargsX :Integer;
79
       procedure SetMargsX( const MargsX_:Integer );
80
       function GetMargsY :Integer;
81
       procedure SetMargsY( const MargsY_:Integer );
82
     public
83
       constructor Create; overload;
84
       constructor Create( const ItemsX_,ItemsY_:Integer ); overload;
85
       constructor Create( const ItemsX_,ItemsY_,Margs_:Integer ); overload;
86
       constructor Create( const ItemsX_,ItemsY_,MargsX_,MargsY_:Integer ); overload; virtual;
87
       procedure AfterConstruction; override;
88
       destructor Destroy; override;
89
       ///// プロパティ
90
       property ItemByte                     :Integer read GetItemByte                 ;
91
       property ElemsP0                      :Pointer read GetElemsP0                  ;
92
       property ElemsX                       :Integer read GetElemsX                   ;
93
       property ElemsY                       :Integer read GetElemsY                   ;
94
       property ElemsN                       :Integer read GetElemsN                   ;
95
       property ElemsByte                    :Integer read GetElemsByte                ;
96
       property Items[ const X_,Y_:Integer ] :_TItem_ read GetItems     write SetItems ; default;
97
       property ItemP[ const X_,Y_:Integer ] :_PItem_ read GetItemP                    ;
98
       property ItemsX                       :Integer read GetItemsX    write SetItemsX;
99
       property ItemsY                       :Integer read GetItemsY    write SetItemsY;
100
       property MargsX                       :Integer read GetMargsX    write SetMargsX;
101
       property MargsY                       :Integer read GetMargsY    write SetMargsY;
102
       ///// メソッド
103
       class procedure Swap( var Array0_,Array1_:TArray2D<_TItem_> ); static;
104
       procedure MakeEdgeLoop;
105
     end;
106

107
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TBricArray2D<_TItem_>
108

109
     IBricArray2D = interface( IArray2D )
110
     ['{F942004C-5B06-4744-9E7C-7E5FCB6258A5}']
111
       ///// アクセス
112
       function GetGridsX :Integer;
113
       procedure SetGridsX( const GridX_:Integer );
114
       function GetGridsY :Integer;
115
       procedure SetGridsY( const GridY_:Integer );
116
       ///// プロパティ
117
       property BricsX :Integer read GetItemsX write SetItemsX;
118
       property BricsY :Integer read GetItemsY write SetItemsY;
119
       property GridsX :Integer read GetGridsX write SetGridsX;
120
       property GridsY :Integer read GetGridsY write SetGridsY;
121
     end;
122

123
     //-------------------------------------------------------------------------
124

125
     TBricArray2D<_TItem_> = class( TArray2D<_TItem_>, IBricArray2D )
126
     private
127
     protected
128
       ///// アクセス
129
       function GetGridsX :Integer;
130
       procedure SetGridsX( const GridsX_:Integer );
131
       function GetGridsY :Integer;
132
       procedure SetGridsY( const GridsY_:Integer );
133
     public
134
       ///// プロパティ
135
       property Brics[ const X_,Y_:Integer ] :_TItem_ read GetItems  write SetItems ; default;
136
       property BricsX                       :Integer read GetItemsX write SetItemsX;
137
       property BricsY                       :Integer read GetItemsY write SetItemsY;
138
       property GridsX                       :Integer read GetGridsX write SetGridsX;
139
       property GridsY                       :Integer read GetGridsY write SetGridsY;
140
     end;
141

142
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGridArray2D<_TItem_>
143

144
     IGridArray2D = interface( IArray2D )
145
     ['{7E34AB1F-480A-4CCF-9719-7938AA1015A9}']
146
       ///// アクセス
147
       function GetBricsX :Integer;
148
       procedure SetBricsX( const BricsX_:Integer );
149
       function GetBricsY :Integer;
150
       procedure SetBricsY( const BricsY_:Integer );
151
       ///// プロパティ
152
       property GridsX :Integer read GetItemsX write SetItemsX;
153
       property GridsY :Integer read GetItemsY write SetItemsY;
154
       property BricsX :Integer read GetBricsX write SetBricsX;
155
       property BricsY :Integer read GetBricsY write SetBricsY;
156
     end;
157

158
     //-------------------------------------------------------------------------
159

160
     TGridArray2D<_TItem_> = class( TArray2D<_TItem_>, IGridArray2D )
161
     private
162
     protected
163
       ///// アクセス
164
       function GetBricsX :Integer;
165
       procedure SetBricsX( const BricsX_:Integer );
166
       function GetBricsY :Integer;
167
       procedure SetBricsY( const BricsY_:Integer );
168
     public
169
       constructor Create( const BricsX_,BricsY_,MargsX_,MargsY_:Integer ); override;
170
       destructor Destroy; override;
171
       ///// プロパティ
172
       property Grids[ const X_,Y_:Integer ] :_TItem_ read GetItems  write SetItems ; default;
173
       property GridsX                       :Integer read GetItemsX write SetItemsX;
174
       property GridsY                       :Integer read GetItemsY write SetItemsY;
175
       property BricsX                       :Integer read GetBricsX write SetBricsX;
176
       property BricsY                       :Integer read GetBricsY write SetBricsY;
177
     end;
178

179
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
180

181
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
182

183
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
184

185
implementation //############################################################### ■
186

187
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
188

189
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
190

191
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TArray2D<_TItem_>
192

193
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
194

195
/////////////////////////////////////////////////////////////////////// メソッド
196

197
procedure TArray2D<_TItem_>.MakeArray;
198
begin
199
     _ElemsX := _MargsX + _ItemsX + _MargsX;
200
     _ElemsY := _MargsY + _ItemsY + _MargsY;
201

202
     SetLength( _Elems, ElemsN );
203
end;
204

205
function TArray2D<_TItem_>.XYtoI( const X_,Y_:Integer ) :Integer;
206
begin
207
     Result := _ElemsX * ( _MargsY + Y_ ) + ( _MargsX + X_ );
208
end;
209

210
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
211

212
/////////////////////////////////////////////////////////////////////// アクセス
213

214
function TArray2D<_TItem_>.GetItemByte :Integer;
215
begin
216
     Result := SizeOf( _TItem_ );
217
end;
218

219
//------------------------------------------------------------------------------
220

221
function TArray2D<_TItem_>.GetElemsP0 :Pointer;
222
begin
223
     Result := @_Elems[ 0 ];
224
end;
225

226
//------------------------------------------------------------------------------
227

228
function TArray2D<_TItem_>.GetElemsX :Integer;
229
begin
230
     Result := _ElemsX;
231
end;
232

233
function TArray2D<_TItem_>.GetElemsY :Integer;
234
begin
235
     Result := _ElemsY;
236
end;
237

238
function TArray2D<_TItem_>.GetElemsN :Integer;
239
begin
240
     Result := _ElemsY * _ElemsX;
241
end;
242

243
function TArray2D<_TItem_>.GetElemsByte :Integer;
244
begin
245
     Result := ItemByte * ElemsN;
246
end;
247

248
//------------------------------------------------------------------------------
249

250
function TArray2D<_TItem_>.GetItems( const X_,Y_:Integer ) :_TItem_;
251
begin
252
     Result := _Elems[ XYtoI( X_, Y_ ) ];
253
end;
254

255
procedure TArray2D<_TItem_>.SetItems( const X_,Y_:Integer; const Item_:_TItem_ );
256
begin
257
     _Elems[ XYtoI( X_, Y_ ) ] := Item_;
258
end;
259

260
function TArray2D<_TItem_>.GetItemP( const X_,Y_:Integer ) :_PItem_;
261
begin
262
     Result := @_Elems[ XYtoI( X_, Y_ ) ];
263
end;
264

265
//------------------------------------------------------------------------------
266

267
function TArray2D<_TItem_>.GetItemsX :Integer;
268
begin
269
     Result := _ItemsX;
270
end;
271

272
procedure TArray2D<_TItem_>.SetItemsX( const ItemsX_:Integer );
273
begin
274
     _ItemsX := ItemsX_;  MakeArray;
275
end;
276

277
function TArray2D<_TItem_>.GetItemsY :Integer;
278
begin
279
     Result := _ItemsY;
280
end;
281

282
procedure TArray2D<_TItem_>.SetItemsY( const ItemsY_:Integer );
283
begin
284
     _ItemsY := ItemsY_;  MakeArray;
285
end;
286

287
function TArray2D<_TItem_>.GetMargsX :Integer;
288
begin
289
     Result := _MargsX;
290
end;
291

292
procedure TArray2D<_TItem_>.SetMargsX( const MargsX_:Integer );
293
begin
294
     _MargsX := MargsX_;  MakeArray;
295
end;
296

297
function TArray2D<_TItem_>.GetMargsY :Integer;
298
begin
299
     Result := _MargsY;
300
end;
301

302
procedure TArray2D<_TItem_>.SetMargsY( const MargsY_:Integer );
303
begin
304
     _MargsY := MargsY_;  MakeArray;
305
end;
306

307
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
308

309
constructor TArray2D<_TItem_>.Create;
310
begin
311
     Create( 0, 0 );
312
end;
313

314
constructor TArray2D<_TItem_>.Create( const ItemsX_,ItemsY_:Integer );
315
begin
316
     Create( ItemsX_, ItemsY_, 0 );
317
end;
318

319
constructor TArray2D<_TItem_>.Create( const ItemsX_,ItemsY_,Margs_:Integer );
320
begin
321
     Create( ItemsX_, ItemsY_, Margs_, Margs_ );
322
end;
323

324
constructor TArray2D<_TItem_>.Create( const ItemsX_,ItemsY_,MargsX_,MargsY_:Integer );
325
begin
326
     inherited Create;
327

328
     _ItemsX := ItemsX_;
329
     _ItemsY := ItemsY_;
330
     _MargsX := MargsX_;
331
     _MargsY := MargsY_;
332
end;
333

334
procedure TArray2D<_TItem_>.AfterConstruction;
335
begin
336
     MakeArray;
337
end;
338

339
destructor TArray2D<_TItem_>.Destroy;
340
begin
341

342
     inherited;
343
end;
344

345
/////////////////////////////////////////////////////////////////////// メソッド
346

347
class procedure TArray2D<_TItem_>.Swap( var Array0_,Array1_:TArray2D<_TItem_> );
348
var
349
   A :TArray2D<_TItem_>;
350
begin
351
     A := Array0_;  Array0_ := Array1_;  Array1_ := A;
352
end;
353

354
procedure TArray2D<_TItem_>.MakeEdgeLoop;
355
var
356
   EX, EY, MX, MY :Integer;
357
begin
358
     for EY := -_MargsY to -1 do
359
     begin
360
          MY := EY + _ItemsY;
361

362
          for EX := -_MargsX to                -1 do Items[ EX, EY ] := Items[ EX + _ItemsX, MY ];
363
          for EX :=  0       to _ItemsX        -1 do Items[ EX, EY ] := Items[ EX          , MY ];
364
          for EX :=  _ItemsX to _ItemsX+_MargsX-1 do Items[ EX, EY ] := Items[ EX - _ItemsX, MY ];
365
     end;
366

367
     for EY := 0 to _ItemsY-1 do
368
     begin
369
          for EX := -_MargsX to                -1 do Items[ EX, EY ] := Items[ EX + _ItemsX, EY ];
370

371
          for EX :=  _ItemsX to _ItemsX+_MargsX-1 do Items[ EX, EY ] := Items[ EX - _ItemsX, EY ];
372
     end;
373

374
     for EY := _ItemsY to _ItemsY+_MargsY-1 do
375
     begin
376
          MY := EY - _ItemsY;
377

378
          for EX := -_MargsX to                -1 do Items[ EX, EY ] := Items[ EX + _ItemsX, MY ];
379
          for EX :=  0       to _ItemsX        -1 do Items[ EX, EY ] := Items[ EX          , MY ];
380
          for EX :=  _ItemsX to _ItemsX+_MargsX-1 do Items[ EX, EY ] := Items[ EX - _ItemsX, MY ];
381
     end;
382
end;
383

384
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TBricArray2D<_TItem_>
385

386
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
387

388
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
389

390
/////////////////////////////////////////////////////////////////////// アクセス
391

392
function TBricArray2D<_TItem_>.GetGridsX :Integer;
393
begin
394
     Result := BricsX + 1;
395
end;
396

397
procedure TBricArray2D<_TItem_>.SetGridsX( const GridsX_:Integer );
398
begin
399
     BricsX := GridsX_ - 1;
400
end;
401

402
function TBricArray2D<_TItem_>.GetGridsY :Integer;
403
begin
404
     Result := BricsY + 1;
405
end;
406

407
procedure TBricArray2D<_TItem_>.SetGridsY( const GridsY_:Integer );
408
begin
409
     BricsY := GridsY_ - 1;
410
end;
411

412
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
413

414
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGridArray2D<_TItem_>
415

416
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
417

418
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
419

420
/////////////////////////////////////////////////////////////////////// アクセス
421

422
function TGridArray2D<_TItem_>.GetBricsX :Integer;
423
begin
424
     Result := _ItemsX - 1;
425
end;
426

427
procedure TGridArray2D<_TItem_>.SetBricsX( const BricsX_:Integer );
428
begin
429
     _ItemsX := BricsX_ + 1;  MakeArray;
430
end;
431

432
function TGridArray2D<_TItem_>.GetBricsY :Integer;
433
begin
434
     Result := _ItemsY - 1;
435
end;
436

437
procedure TGridArray2D<_TItem_>.SetBricsY( const BricsY_:Integer );
438
begin
439
     _ItemsY := BricsY_ + 1;  MakeArray;
440
end;
441

442
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
443

444
constructor TGridArray2D<_TItem_>.Create( const BricsX_,BricsY_,MargsX_,MargsY_:Integer );
445
begin
446
     inherited Create( BricsX_+1, BricsY_+1,
447
                       MargsX_  , MargsY_   );
448

449
end;
450

451
destructor TGridArray2D<_TItem_>.Destroy;
452
begin
453

454
     inherited;
455
end;
456

457
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
458

459
//############################################################################## □
460

461
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
462

463
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
464

465
end. //######################################################################### ■
466
Luxophia

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