Subversion Repositories spacemission

Rev

Rev 4 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 daniel-mar 1
unit DXSprite;
2
 
3
interface
4 daniel-mar 4
 
1 daniel-mar 5
{$INCLUDE DelphiXcfg.inc}
6
 
7
uses
4 daniel-mar 8
  Windows, SysUtils, Classes, Graphics, DXClass, DXDraws,
9
  {$IFDEF VER9UP} Types,{$ENDIF}
10
{$IFDEF StandardDX}
11
  DirectDraw;
12
{$ELSE}
13
  DirectX;
14
{$ENDIF}
1 daniel-mar 15
 
16
type
17
 
18
  {  ESpriteError  }
19
 
20
  ESpriteError = class(Exception);
21
 
22
  {  TSprite  }
23
 
24
  TSpriteEngine = class;
25
 
4 daniel-mar 26
  TSprite = class;
27
  TCollisionEvent = procedure(Sender: TObject; var Done: Boolean) of object;
28
  TMoveEvent = procedure(Sender: TObject; var MoveCount: Integer) of object;
29
  TDrawEvent = procedure(Sender: TObject) of object;
30
  TGetImage = procedure(Sender: TObject; var Image: TPictureCollectionItem) of object;
31
 
32
  TSprite = class(TPersistent)
1 daniel-mar 33
  private
34
    FEngine: TSpriteEngine;
35
    FParent: TSprite;
36
    FList: TList;
37
    FDeaded: Boolean;
38
    FDrawList: TList;
39
    FCollisioned: Boolean;
40
    FMoved: Boolean;
41
    FVisible: Boolean;
42
    FX: Double;
43
    FY: Double;
44
    FZ: Integer;
45
    FWidth: Integer;
46
    FHeight: Integer;
4 daniel-mar 47
    {$IFDEF Ver4Up}
48
    FSelected: Boolean;
49
    FGroupNumber: Integer;
50
    {$ENDIF}
51
    FCaption: string;
52
    FTag: Integer;
53
 
54
    FDXImageList: TCustomDXImageList;
55
    FDXImage: TPictureCollectionItem;
56
    FDXImageName: string;
57
 
58
    FOnDraw: TDrawEvent;
59
    FOnMove: TMoveEvent;
60
    FOnCollision: TCollisionEvent;
61
    FOnGetImage: TGetImage;
1 daniel-mar 62
    procedure Add(Sprite: TSprite);
63
    procedure Remove(Sprite: TSprite);
64
    procedure AddDrawList(Sprite: TSprite);
65
    procedure Collision2;
4 daniel-mar 66
    procedure Draw; {$IFDEF VER9UP}inline;{$ENDIF}
1 daniel-mar 67
    function GetClientRect: TRect;
68
    function GetCount: Integer;
69
    function GetItem(Index: Integer): TSprite;
4 daniel-mar 70
    function GetWorldX: Double; {$IFDEF VER9UP}inline;{$ENDIF}
71
    function GetWorldY: Double; {$IFDEF VER9UP}inline;{$ENDIF}
1 daniel-mar 72
    procedure SetZ(Value: Integer);
73
  protected
74
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); virtual;
75
    procedure DoDraw; virtual;
76
    procedure DoMove(MoveCount: Integer); virtual;
77
    function GetBoundsRect: TRect; virtual;
78
    function TestCollision(Sprite: TSprite): Boolean; virtual;
4 daniel-mar 79
    {$IFDEF Ver4Up}
80
    procedure SetGroupNumber(AGroupNumber: Integer); virtual;
81
    procedure SetSelected(ASelected: Boolean); virtual;
82
    {$ENDIF}
1 daniel-mar 83
  public
84
    constructor Create(AParent: TSprite); virtual;
85
    destructor Destroy; override;
86
    procedure Clear;
87
    function Collision: Integer;
88
    procedure Dead;
89
    procedure Move(MoveCount: Integer);
4 daniel-mar 90
    procedure ReAnimate(MoveCount: Integer); virtual;
91
    function GetSpriteAt(X, Y: Integer): TSprite;
1 daniel-mar 92
    property BoundsRect: TRect read GetBoundsRect;
93
    property ClientRect: TRect read GetClientRect;
94
    property Count: Integer read GetCount;
95
    property Engine: TSpriteEngine read FEngine;
96
    property Items[Index: Integer]: TSprite read GetItem; default;
4 daniel-mar 97
    property Deaded: Boolean read FDeaded;
1 daniel-mar 98
    property Parent: TSprite read FParent;
99
    property WorldX: Double read GetWorldX;
100
    property WorldY: Double read GetWorldY;
4 daniel-mar 101
    // Group handling support
102
    {$IFDEF Ver4Up}  // if GroupNumber < 0 then no group is assigned
103
    property GroupNumber: Integer read FGroupNumber write SetGroupNumber;
104
    property Selected: Boolean read FSelected write SetSelected;
105
    {$ENDIF}
106
    procedure Assign(Source: TPersistent); override;
107
  published
1 daniel-mar 108
    property Height: Integer read FHeight write FHeight;
4 daniel-mar 109
    property Moved: Boolean read FMoved write FMoved;
110
    property Visible: Boolean read FVisible write FVisible;
111
    property Width: Integer read FWidth write FWidth;
1 daniel-mar 112
    property X: Double read FX write FX;
113
    property Y: Double read FY write FY;
114
    property Z: Integer read FZ write SetZ;
4 daniel-mar 115
    property Collisioned: Boolean read FCollisioned write FCollisioned;
116
    property Tag: Integer read FTag write FTag;
117
    property Caption: string read FCaption write FCaption;
118
 
119
    property DXImageList: TCustomDXImageList read FDXImageList write FDXImageList;
120
    property DXImageName: string read FDXImageName write FDXImageName;
121
 
122
    property OnDraw: TDrawEvent read FOnDraw write FOnDraw;
123
    property OnMove: TMoveEvent read FOnMove write FOnMove;
124
    property OnCollision: TCollisionEvent read FOnCollision write FOnCollision;
125
    property OnGetImage: TGetImage read FOnGetImage write FOnGetImage;
1 daniel-mar 126
  end;
127
 
4 daniel-mar 128
  TSpriteClass = class of TSprite;
129
 
1 daniel-mar 130
  {  TImageSprite  }
131
 
132
  TImageSprite = class(TSprite)
133
  private
134
    FAnimCount: Integer;
135
    FAnimLooped: Boolean;
136
    FAnimPos: Double;
137
    FAnimSpeed: Double;
138
    FAnimStart: Integer;
139
    FPixelCheck: Boolean;
140
    FTile: Boolean;
141
    FTransparent: Boolean;
4 daniel-mar 142
    FAngle: Single;
143
    FAlpha: Integer;
144
    FBlendMode: TRenderType;
145
    FCenterX: Double;
146
    FCenterY: Double;
147
    FBlurImageArr: TBlurImageArr;
148
    FBlurImage: Boolean;
149
    FMirrorFlip: TRenderMirrorFlipSet;
150
    FTextureFilter: TD2DTextureFilter;
1 daniel-mar 151
    function GetDrawImageIndex: Integer;
152
    function GetDrawRect: TRect;
4 daniel-mar 153
    function ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
154
      const rect1, rect2: TRect; x1, y1, x2, y2: Integer;
155
      DoPixelCheck: Boolean): Boolean;
156
    function StoreCenterX: Boolean;
157
    function StoreCenterY: Boolean;
158
    function StoreAlpha: Boolean;
159
    procedure SetBlurImage(const Value: Boolean);
160
    procedure SetBlurImageArr(const Value: TBlurImageArr);
161
    function GetImage: TPictureCollectionItem;
162
    procedure SetMirrorFlip(const Value: TRenderMirrorFlipSet);
163
    procedure ReadMirrorFlip(Reader: TReader);
164
    procedure WriteMirrorFlip(Writer: TWriter);
1 daniel-mar 165
  protected
4 daniel-mar 166
    {accessed methods}
167
    procedure ReadAlpha(Reader: TReader);
168
    procedure ReadAngle(Reader: TReader);
169
    procedure ReadAnimCount(Reader: TReader);
170
    procedure ReadAnimLooped(Reader: TReader);
171
    procedure ReadAnimPos(Reader: TReader);
172
    procedure ReadAnimSpeed(Reader: TReader);
173
    procedure ReadAnimStart(Reader: TReader);
174
    procedure ReadBlendMode(Reader: TReader);
175
    procedure ReadCenterX(Reader: TReader);
176
    procedure ReadCenterY(Reader: TReader);
177
    procedure ReadPixelCheck(Reader: TReader);
178
    procedure ReadTile(Reader: TReader);
179
    procedure ReadBlurImage(Reader: TReader);
180
    procedure ReadTextureFilter(Reader: TReader);
181
    procedure WriteAlpha(Writer: TWriter);
182
    procedure WriteAngle(Writer: TWriter);
183
    procedure WriteAnimCount(Writer: TWriter);
184
    procedure WriteAnimLooped(Writer: TWriter);
185
    procedure WriteAnimPos(Writer: TWriter);
186
    procedure WriteAnimSpeed(Writer: TWriter);
187
    procedure WriteAnimStart(Writer: TWriter);
188
    procedure WriteBlendMode(Writer: TWriter);
189
    procedure WriteCenterX(Writer: TWriter);
190
    procedure WriteCenterY(Writer: TWriter);
191
    procedure WritePixelCheck(Writer: TWriter);
192
    procedure WriteTile(Writer: TWriter);
193
    procedure WriteBlurImage(Writer: TWriter);
194
    procedure WriteTextureFilter(Writer: TWriter);
195
    {own store of properties}
196
    procedure DefineProperties(Filer: TFiler); override;
197
    procedure LoadImage; virtual;
1 daniel-mar 198
    procedure DoDraw; override;
199
    procedure DoMove(MoveCount: Integer); override;
200
    function GetBoundsRect: TRect; override;
201
    function TestCollision(Sprite: TSprite): Boolean; override;
4 daniel-mar 202
    procedure SetImage(AImage: TPictureCollectionItem); virtual;
1 daniel-mar 203
  public
204
    constructor Create(AParent: TSprite); override;
4 daniel-mar 205
    procedure Assign(Source: TPersistent); override;
206
    procedure ReAnimate(MoveCount: Integer); override;
207
    property Image: TPictureCollectionItem read GetImage write SetImage;
208
    property BlurImageArr: TBlurImageArr read FBlurImageArr write SetBlurImageArr;
209
    {un-published property}
210
    property BlendMode: TRenderType read FBlendMode write FBlendMode default rtDraw;
211
    property Angle: Single read FAngle write FAngle stored StoreAlpha;
212
    property Alpha: Integer read FAlpha write FAlpha default $FF;
213
    property CenterX: Double read FCenterX write FCenterX stored StoreCenterX;
214
    property CenterY: Double read FCenterY write FCenterY stored StoreCenterY;
215
    property AnimCount: Integer read FAnimCount write FAnimCount default 0;
216
    property AnimLooped: Boolean read FAnimLooped write FAnimLooped default False;
1 daniel-mar 217
    property AnimPos: Double read FAnimPos write FAnimPos;
218
    property AnimSpeed: Double read FAnimSpeed write FAnimSpeed;
4 daniel-mar 219
    property AnimStart: Integer read FAnimStart write FAnimStart default 0;
220
    property PixelCheck: Boolean read FPixelCheck write FPixelCheck default False;
221
    property Tile: Boolean read FTile write FTile default False;
222
    property BlurImage: Boolean read FBlurImage write SetBlurImage default False;
223
    property MirrorFlip: TRenderMirrorFlipSet read FMirrorFlip write SetMirrorFlip default [];
224
    property TextureFilter: TD2DTextureFilter read FTextureFilter write FTextureFilter default D2D_POINT;
225
  published
226
    property DXImageList;
227
    property DXImageName;
228
 
229
    property OnDraw;
230
    property OnMove;
231
    property OnCollision;
232
    property OnGetImage;
1 daniel-mar 233
  end;
234
 
235
  {  TImageSpriteEx  }
236
 
237
  TImageSpriteEx = class(TImageSprite)
4 daniel-mar 238
  end{$IFDEF VER9UP}deprecated{$IFDEF VER14UP} 'Use for backward compatibility only or replace by TImageSprite instead...'{$ENDIF}{$ENDIF};
239
 
1 daniel-mar 240
  {  TBackgroundSprite  }
241
 
4 daniel-mar 242
  PMapType = ^TMapType;
243
  TMapType = packed record
244
    MapChip: Integer; {image chip as number}
245
    //ImageName: string[127];
246
    CollisionChip: Boolean; {is collision brick}
247
    CollisionRect: TRect; {dirty vollision area, can be smaller or bigger than silhouette}
248
    Overlap: Integer; {for pulse image, like zoom etc.}
249
    AnimLooped: Boolean; {chip can be live}
250
    AnimStart, AnimCount: Integer;
251
    AnimSpeed, AnimPos: Double; {phase of picture by one map chip}
252
    Rendered: TRenderType; {can be blended}
253
    Alpha: Byte; {and blend level}
254
    Angle: Single;
255
    CenterX, CenterY: Double;
256
    MirrorFlip: TRenderMirrorFlipSet;
257
    TextureFilter: TD2DTextureFilter;
258
    Tag: Integer; {for application use}
259
  end;
260
 
261
  TBackgroundSprite = class(TImageSprite)
1 daniel-mar 262
  private
263
    FMap: Pointer;
264
    FMapWidth: Integer;
265
    FMapHeight: Integer;
4 daniel-mar 266
 
267
    FChipsRect: TRect;
268
    FChipsPatternIndex: Integer;
1 daniel-mar 269
    function GetCollisionMapItem(X, Y: Integer): Boolean;
270
    function GetChip(X, Y: Integer): Integer;
271
    procedure SetChip(X, Y: Integer; Value: Integer);
272
    procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean);
273
    procedure SetMapHeight(Value: Integer);
274
    procedure SetMapWidth(Value: Integer);
4 daniel-mar 275
 
276
    function GetCollisionRectItem(X, Y: Integer): TRect;
277
    function GetMap(X, Y: Integer): TMapType;
278
    function GetTagMap(X, Y: Integer): Integer;
279
    procedure SetCollisionRectItem(X, Y: Integer; Value: TRect);
280
    procedure SetMap(X, Y: Integer; Value: TMapType);
281
    procedure SetTagMap(X, Y, Value: Integer);
282
    function GetOverlap(X, Y: Integer): Integer;
283
    procedure SetOverlap(X, Y: Integer; const Value: Integer);
1 daniel-mar 284
  protected
4 daniel-mar 285
    procedure ReadMapData(Stream: TStream);
286
    procedure WriteMapData(Stream: TStream);
1 daniel-mar 287
    procedure DoDraw; override;
288
    function GetBoundsRect: TRect; override;
289
    function TestCollision(Sprite: TSprite): Boolean; override;
4 daniel-mar 290
    procedure SetImage(Img: TPictureCollectionItem); override;
291
    procedure DefineProperties(Filer: TFiler); override;
1 daniel-mar 292
  public
293
    constructor Create(AParent: TSprite); override;
294
    destructor Destroy; override;
4 daniel-mar 295
    procedure ChipsDraw(Image: TPictureCollectionItem; X, Y, PatternIndex: Integer);
1 daniel-mar 296
    procedure SetMapSize(AMapWidth, AMapHeight: Integer);
4 daniel-mar 297
    function IsMapEmpty: Boolean;
1 daniel-mar 298
    property Chips[X, Y: Integer]: Integer read GetChip write SetChip;
299
    property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem;
4 daniel-mar 300
    property CollisionRect[X, Y: Integer]: TRect read GetCollisionRectItem write SetCollisionRectItem;
301
    property Overlap[X, Y: Integer]: Integer read GetOverlap write SetOverlap;
302
    property TagMap[X, Y: Integer]: Integer read GetTagMap write SetTagMap;
303
    property Map[X, Y: Integer]: TMapType read GetMap write SetMap;
304
    procedure Assign(Source: TPersistent); override;
305
    property ChipsRect: TRect read FChipsRect write FChipsRect;
306
    property ChipsPatternIndex: Integer read FChipsPatternIndex write FChipsPatternIndex default 0;
307
    {un-published property}
1 daniel-mar 308
    property MapHeight: Integer read FMapHeight write SetMapHeight;
309
    property MapWidth: Integer read FMapWidth write SetMapWidth;
4 daniel-mar 310
  published
311
    property DXImageList;
312
    property DXImageName;
313
 
314
    property OnDraw;
315
    property OnMove;
316
    property OnCollision;
317
    property OnGetImage;
1 daniel-mar 318
  end;
319
 
4 daniel-mar 320
  {  forward class  }
321
 
322
  TCustomDXSpriteEngine = class;
323
 
1 daniel-mar 324
  {  TSpriteEngine  }
325
 
326
  TSpriteEngine = class(TSprite)
327
  private
4 daniel-mar 328
    FOwner: TCustomDXSpriteEngine;
1 daniel-mar 329
    FAllCount: Integer;
330
    FCollisionCount: Integer;
331
    FCollisionDone: Boolean;
332
    FCollisionRect: TRect;
333
    FCollisionSprite: TSprite;
334
    FDeadList: TList;
335
    FDrawCount: Integer;
336
    FSurface: TDirectDrawSurface;
337
    FSurfaceRect: TRect;
4 daniel-mar 338
{$IFDEF Ver4Up}
339
    FObjectsSelected: Boolean;
340
    FGroupCount: Integer;
341
    FGroups: array of Tlist;
342
    FCurrentSelected: Tlist;
343
{$ENDIF}
344
  protected
345
    procedure SetSurface(Value: TDirectDrawSurface); virtual;
346
{$IFDEF Ver4Up}
347
    procedure SetGroupCount(AGroupCount: Integer); virtual;
348
    function GetGroup(Index: Integer): Tlist; virtual;
349
{$ENDIF}
1 daniel-mar 350
  public
351
    constructor Create(AParent: TSprite); override;
352
    destructor Destroy; override;
353
    procedure Dead;
354
    procedure Draw;
355
    property AllCount: Integer read FAllCount;
356
    property DrawCount: Integer read FDrawCount;
357
    property Surface: TDirectDrawSurface read FSurface write SetSurface;
358
    property SurfaceRect: TRect read FSurfaceRect;
4 daniel-mar 359
 
360
    // Extended Sprite Engine
361
    procedure Collisions;
362
 
363
    // Group handling support
364
    {$IFDEF Ver4Up}
365
    procedure ClearCurrent;
366
    procedure ClearGroup(GroupNumber: Integer);
367
    procedure GroupToCurrent(GroupNumber: Integer; Add: Boolean = False);
368
    procedure CurrentToGroup(GroupNumber: Integer; Add: Boolean = False);
369
    procedure GroupSelect(const Area: TRect; Filter: array of TSpriteClass; Add: Boolean = False); overload;
370
    procedure GroupSelect(const Area: TRect; Add: Boolean = False); overload;
371
    function Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = False): Tsprite; overload;
372
    function Select(Point: TPoint; Add: Boolean = False): Tsprite; overload;
373
 
374
    property CurrentSelected: TList read fCurrentSelected;
375
    property ObjectsSelected: Boolean read fObjectsSelected;
376
    property Groups[Index: Integer]: Tlist read GetGroup;
377
    property GroupCount: Integer read fGroupCount write SetGroupCount;
378
    {$ENDIF}
1 daniel-mar 379
  end;
380
 
381
  {  EDXSpriteEngineError  }
382
 
383
  EDXSpriteEngineError = class(Exception);
384
 
4 daniel-mar 385
  TSpriteCollection = class;
386
 
387
  {  TSpriteType  }
388
 
389
  TSpriteType = (stSprite, stImageSprite, stImageSpriteEx, stBackgroundSprite);
390
 
391
  {  TSpriteCollectionItem  }
392
 
393
  TSpriteCollectionItem = class(THashCollectionItem)
394
  private
395
    FOwner: TPersistent;
396
    FOwnerItem: TSpriteEngine;
397
    FSpriteType: TSpriteType;
398
    FSprite: TSprite;
399
    procedure Finalize;
400
    procedure Initialize;
401
    function GetSpriteCollection: TSpriteCollection;
402
    procedure SetSprite(const Value: TSprite);
403
    procedure SetOnCollision(const Value: TCollisionEvent);
404
    procedure SetOnDraw(const Value: TDrawEvent);
405
    procedure SetOnMove(const Value: TMoveEvent);
406
    function GetSpriteType: TSpriteType;
407
    procedure SetSpriteType(const Value: TSpriteType);
408
    function GetOnCollision: TCollisionEvent;
409
    function GetOnDraw: TDrawEvent;
410
    function GetOnMove: TMoveEvent;
411
    function GetOnGetImage: TGetImage;
412
    procedure SetOnGetImage(const Value: TGetImage);
413
    function GetImageList: TCustomDXImageList;
414
    procedure SetImageList(const Value: TCustomDXImageList);
415
  protected
416
    function GetDisplayName: string; override;
417
    procedure SetDisplayName(const Value: string); override;
418
  public
419
    constructor Create(Collection: TCollection); override;
420
    destructor Destroy; override;
421
    procedure Assign(Source: TPersistent); override;
422
    property SpriteCollection: TSpriteCollection read GetSpriteCollection;
423
    function Clone(NewName: string): TSprite;
424
  published
425
    {published property of sprite}
426
    property KindSprite: TSpriteType read GetSpriteType write SetSpriteType;
427
    property ImageList: TCustomDXImageList read GetImageList write SetImageList;
428
    property Sprite: TSprite read FSprite write SetSprite;
429
    {published events of sprite}
430
    property OnDraw: TDrawEvent read GetOnDraw write SetOnDraw;
431
    property OnMove: TMoveEvent read GetOnMove write SetOnMove;
432
    property OnCollision: TCollisionEvent read GetOnCollision write SetOnCollision;
433
    property OnGetImage: TGetImage read GetOnGetImage write SetOnGetImage;
434
  end;
435
 
436
  {  ESpriteCollectionError  }
437
 
438
  ESpriteCollectionError = class(Exception);
439
 
440
  {  TSpriteCollection  }
441
 
442
  TSCInitialize = procedure(Owner: TSpriteEngine) of object;
443
  TSCFinalize = procedure(Owner: TSpriteEngine) of object;
444
 
445
  TSpriteCollection = class(THashCollection)
446
  private
447
    FInitializeFlag: Boolean;
448
    FOwner: TPersistent;
449
    FOwnerItem: TSpriteEngine;
450
    FOnInitialize: TSCInitialize;
451
    FOnFinalize: TSCFinalize;
452
    function GetItem(Index: Integer): TSpriteCollectionItem;
453
  protected
454
    function GetOwner: TPersistent; override;
455
  public
456
    constructor Create(AOwner: TPersistent);
457
    destructor Destroy; override;
458
    function Initialized: Boolean;
459
    function Find(const Name: string): TSpriteCollectionItem;
460
    function Add: TSpriteCollectionItem;
461
    procedure Finalize;
462
    function Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
463
    property Items[Index: Integer]: TSpriteCollectionItem read GetItem; default;
464
  published
465
    property OnInitialize: TSCInitialize read FOnInitialize write FOnInitialize;
466
    property OnFinalize: TSCFinalize read FOnFinalize write FOnFinalize;
467
  end;
468
 
1 daniel-mar 469
  {  TCustomDXSpriteEngine  }
470
 
471
  TCustomDXSpriteEngine = class(TComponent)
472
  private
473
    FDXDraw: TCustomDXDraw;
474
    FEngine: TSpriteEngine;
4 daniel-mar 475
    FItems: TSpriteCollection;
1 daniel-mar 476
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
477
    procedure SetDXDraw(Value: TCustomDXDraw);
4 daniel-mar 478
    procedure SetItems(const Value: TSpriteCollection);
1 daniel-mar 479
  protected
480
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
481
  public
4 daniel-mar 482
    constructor Create(AOwner: TComponent); override;
1 daniel-mar 483
    destructor Destroy; override;
484
    procedure Dead;
485
    procedure Draw;
486
    procedure Move(MoveCount: Integer);
4 daniel-mar 487
    procedure Clone(const Amount: Word; const BaseNameOfSprite: string);
488
    function ForEach(PrefixNameOdSprite: string; var Names: TStringList): Boolean;
1 daniel-mar 489
    property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
4 daniel-mar 490
    property Engine: TSpriteEngine read FEngine;
491
    property Items: TSpriteCollection read FItems write SetItems;
1 daniel-mar 492
  end;
493
 
494
  {  TDXSpriteEngine  }
495
 
496
  TDXSpriteEngine = class(TCustomDXSpriteEngine)
4 daniel-mar 497
    property Items;
1 daniel-mar 498
  published
499
    property DXDraw;
500
  end;
501
 
4 daniel-mar 502
function Mod2(i, i2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
503
function Mod2f(i: Double; i2: Integer): Double; {$IFDEF VER9UP}inline;{$ENDIF}
504
function DefaultMapChip(iMapChip: Integer = -1; iCollisionChip: Boolean = False): TMapType; {$IFDEF VER9UP}inline;{$ENDIF}
505
 
1 daniel-mar 506
implementation
507
 
4 daniel-mar 508
uses DXConsts, TypInfo;
1 daniel-mar 509
 
4 daniel-mar 510
const
511
  SSpriteNotFound = 'Sprite not found';
512
  SSpriteDuplicateName = 'Item duplicate name "%s" error';
513
 
514
function DefaultMapChip(iMapChip: Integer = -1; iCollisionChip: Boolean = False): TMapType;
515
begin
516
  FillChar(Result, SizeOf(Result), 0);
517
  with Result do
518
  begin
519
    MapChip := iMapChip; {image chip as number}
520
    CollisionChip := iCollisionChip; {is collision brick}
521
//    CollisionRect: TRect; {dirty vollision area, can be smaller or bigger than silhouette}
522
//    Overlap: Integer; {for pulse image, like zoom etc.}
523
//    AnimLooped: Boolean; {chip can be live}
524
//    AnimStart, AnimCount: Integer;
525
//    AnimSpeed, AnimPos: Double; {phase of picture by one map chip}
526
    Rendered := rtDraw; {can be blended}
527
    Alpha := $FF; {and blend level}
528
    Angle := 0;
529
    CenterX := 0.5;
530
    CenterY := 0.5;
531
    TextureFilter := D2D_POINT;
532
//    Tag: Integer; {for application use}
533
  end;
534
end;
535
 
1 daniel-mar 536
function Mod2(i, i2: Integer): Integer;
537
begin
538
  Result := i mod i2;
4 daniel-mar 539
  if Result < 0 then
540
    Result := i2 + Result;
1 daniel-mar 541
end;
542
 
543
function Mod2f(i: Double; i2: Integer): Double;
544
begin
4 daniel-mar 545
  if i2 = 0 then
1 daniel-mar 546
    Result := i
547
  else
548
  begin
4 daniel-mar 549
    Result := i - Round(i / i2) * i2;
550
    if Result < 0 then
551
      Result := i2 + Result;
1 daniel-mar 552
  end;
553
end;
554
 
555
{  TSprite  }
556
 
557
constructor TSprite.Create(AParent: TSprite);
558
begin
559
  inherited Create;
4 daniel-mar 560
{$IFDEF Ver4Up}
561
  fGroupnumber := -1;
562
{$ENDIF}
1 daniel-mar 563
  FParent := AParent;
4 daniel-mar 564
  if FParent <> nil then
1 daniel-mar 565
  begin
566
    FParent.Add(Self);
567
    if FParent is TSpriteEngine then
568
      FEngine := TSpriteEngine(FParent)
569
    else
570
      FEngine := FParent.Engine;
571
    Inc(FEngine.FAllCount);
572
  end;
573
 
574
  FCollisioned := True;
575
  FMoved := True;
576
  FVisible := True;
577
end;
578
 
579
destructor TSprite.Destroy;
580
begin
4 daniel-mar 581
{$IFDEF Ver4Up}
582
  GroupNumber := -1;
583
  Selected := False;
584
{$ENDIF}
1 daniel-mar 585
  Clear;
4 daniel-mar 586
  if FParent <> nil then
1 daniel-mar 587
  begin
588
    Dec(FEngine.FAllCount);
589
    FParent.Remove(Self);
590
    FEngine.FDeadList.Remove(Self);
591
  end;
592
  FList.Free;
593
  FDrawList.Free;
594
  inherited Destroy;
595
end;
596
 
4 daniel-mar 597
{$IFDEF Ver4Up}
598
 
599
procedure TSprite.SetGroupNumber(AGroupNumber: Integer);
600
begin
601
  if (AGroupNumber <> GroupNumber) and (Engine <> nil) then
602
  begin
603
    if Groupnumber >= 0 then
604
      Engine.Groups[GroupNumber].Remove(self);
605
    if AGroupNumber >= 0 then
606
      Engine.Groups[AGroupNumber].Add(self);
607
  end;
608
end; {SetGroupNumber}
609
 
610
procedure TSprite.SetSelected(ASelected: Boolean);
611
begin
612
  if (ASelected <> fSelected) and (Engine <> nil) then
613
  begin
614
    fSelected := ASelected;
615
    if Selected then
616
      Engine.CurrentSelected.Add(self)
617
    else
618
      Engine.CurrentSelected.Remove(self);
619
    Engine.fObjectsSelected := Engine.CurrentSelected.count <> 0;
620
  end;
621
end;
622
{$ENDIF}
623
 
1 daniel-mar 624
procedure TSprite.Add(Sprite: TSprite);
625
begin
4 daniel-mar 626
  if FList = nil then
1 daniel-mar 627
  begin
628
    FList := TList.Create;
629
    FDrawList := TList.Create;
630
  end;
631
  FList.Add(Sprite);
632
  AddDrawList(Sprite);
633
end;
634
 
635
procedure TSprite.Remove(Sprite: TSprite);
636
begin
637
  FList.Remove(Sprite);
638
  FDrawList.Remove(Sprite);
4 daniel-mar 639
  if FList.Count = 0 then
1 daniel-mar 640
  begin
641
    FList.Free;
642
    FList := nil;
643
    FDrawList.Free;
644
    FDrawList := nil;
645
  end;
646
end;
647
 
648
procedure TSprite.AddDrawList(Sprite: TSprite);
649
var
650
  L, H, I, C: Integer;
651
begin
652
  L := 0;
653
  H := FDrawList.Count - 1;
654
  while L <= H do
655
  begin
656
    I := (L + H) div 2;
4 daniel-mar 657
    C := TSprite(FDrawList[I]).Z - Sprite.Z;
658
    if C < 0 then
659
      L := I + 1
660
    else
1 daniel-mar 661
      H := I - 1;
662
  end;
663
  FDrawList.Insert(L, Sprite);
664
end;
665
 
666
procedure TSprite.Clear;
667
begin
4 daniel-mar 668
  while Count > 0 do
669
    Items[Count - 1].Free;
1 daniel-mar 670
end;
671
 
672
function TSprite.Collision: Integer;
673
var
674
  i: Integer;
675
begin
676
  Result := 0;
4 daniel-mar 677
  if (FEngine <> nil) and (not FDeaded) and (Collisioned) then
1 daniel-mar 678
  begin
679
    with FEngine do
680
    begin
681
      FCollisionCount := 0;
682
      FCollisionDone := False;
683
      FCollisionRect := Self.BoundsRect;
684
      FCollisionSprite := Self;
685
 
4 daniel-mar 686
      for i := 0 to Count - 1 do
1 daniel-mar 687
        Items[i].Collision2;
688
 
689
      Result := FCollisionCount;
690
    end;
691
  end;
692
end;
693
 
694
procedure TSprite.Collision2;
695
var
696
  i: Integer;
697
begin
698
  if Collisioned then
699
  begin
4 daniel-mar 700
    if (Self <> FEngine.FCollisionSprite) and OverlapRect(BoundsRect,
701
      FEngine.FCollisionRect) and FEngine.FCollisionSprite.TestCollision(Self) and
702
      TestCollision(FEngine.FCollisionSprite) then
1 daniel-mar 703
    begin
704
      Inc(FEngine.FCollisionCount);
705
      FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone);
4 daniel-mar 706
      if (not FEngine.FCollisionSprite.Collisioned) or
707
        (FEngine.FCollisionSprite.FDeaded) then
1 daniel-mar 708
      begin
709
        FEngine.FCollisionDone := True;
710
      end;
711
    end;
4 daniel-mar 712
    if FEngine.FCollisionDone then
713
      Exit;
714
    for i := 0 to Count - 1 do
1 daniel-mar 715
      Items[i].Collision2;
716
  end;
717
end;
718
 
719
procedure TSprite.Dead;
720
begin
4 daniel-mar 721
  if (FEngine <> nil) and (not FDeaded) then
1 daniel-mar 722
  begin
723
    FDeaded := True;
724
    FEngine.FDeadList.Add(Self);
725
  end;
726
end;
727
 
4 daniel-mar 728
procedure TSprite.DoMove(MoveCount: Integer);
1 daniel-mar 729
begin
4 daniel-mar 730
  if AsSigned(FOnMove) then
731
    FOnMove(Self, MoveCount);
1 daniel-mar 732
end;
733
 
734
procedure TSprite.DoDraw;
735
begin
4 daniel-mar 736
  if AsSigned(FOnDraw) then
737
    FOnDraw(Self);
1 daniel-mar 738
end;
739
 
740
procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
741
begin
4 daniel-mar 742
  if AsSigned(FOnCollision) then
743
    FOnCollision(Sprite, Done);
1 daniel-mar 744
end;
745
 
746
function TSprite.TestCollision(Sprite: TSprite): Boolean;
747
begin
748
  Result := True;
749
end;
750
 
751
procedure TSprite.Move(MoveCount: Integer);
752
var
753
  i: Integer;
754
begin
755
  if FMoved then
756
  begin
4 daniel-mar 757
    DoMove(MoveCount); ReAnimate(MoveCount);
758
    for i := 0 to Count - 1 do
1 daniel-mar 759
      Items[i].Move(MoveCount);
760
  end;
761
end;
762
 
763
procedure TSprite.Draw;
764
var
765
  i: Integer;
766
begin
767
  if FVisible then
768
  begin
4 daniel-mar 769
    if FEngine <> nil then
1 daniel-mar 770
    begin
771
      if OverlapRect(FEngine.FSurfaceRect, BoundsRect) then
772
      begin
773
        DoDraw;
774
        Inc(FEngine.FDrawCount);
775
      end;
776
    end;
777
 
4 daniel-mar 778
    if FDrawList <> nil then
1 daniel-mar 779
    begin
4 daniel-mar 780
      for i := 0 to FDrawList.Count - 1 do
781
      begin
782
        TSprite(FDrawList[i]).Draw;
783
      end;
1 daniel-mar 784
    end;
785
  end;
786
end;
787
 
788
function TSprite.GetSpriteAt(X, Y: Integer): TSprite;
789
 
790
  procedure Collision_GetSpriteAt(X, Y: Double; Sprite: TSprite);
791
  var
792
    i: Integer;
793
    X2, Y2: Double;
794
  begin
4 daniel-mar 795
    if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)),
796
      Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Height)) then //corrected by Sergey
1 daniel-mar 797
    begin
4 daniel-mar 798
      if (Result = nil) or (Sprite.Z > Result.Z) then
1 daniel-mar 799
        Result := Sprite;
800
    end;
801
 
4 daniel-mar 802
    X2 := X - Sprite.X;
803
    Y2 := Y - Sprite.Y;
804
    for i := 0 to Sprite.Count - 1 do
1 daniel-mar 805
      Collision_GetSpriteAt(X2, Y2, Sprite.Items[i]);
806
  end;
807
 
808
var
809
  i: Integer;
810
  X2, Y2: Double;
811
begin
812
  Result := nil;
813
 
4 daniel-mar 814
  X2 := X - Self.X;
815
  Y2 := Y - Self.Y;
816
  for i := 0 to Count - 1 do
1 daniel-mar 817
    Collision_GetSpriteAt(X2, Y2, Items[i]);
4 daniel-mar 818
end;
1 daniel-mar 819
 
820
function TSprite.GetBoundsRect: TRect;
821
begin
4 daniel-mar 822
  Result := Bounds(Round(WorldX), Round(WorldY), Width, Height);
1 daniel-mar 823
end;
824
 
825
function TSprite.GetClientRect: TRect;
826
begin
827
  Result := Bounds(0, 0, Width, Height);
828
end;
829
 
830
function TSprite.GetCount: Integer;
831
begin
4 daniel-mar 832
  if FList <> nil then
1 daniel-mar 833
    Result := FList.Count
834
  else
835
    Result := 0;
836
end;
837
 
838
function TSprite.GetItem(Index: Integer): TSprite;
839
begin
4 daniel-mar 840
  if FList <> nil then
1 daniel-mar 841
    Result := FList[Index]
842
  else
843
    raise ESpriteError.CreateFmt(SListIndexError, [Index]);
4 daniel-mar 844
end;
1 daniel-mar 845
 
846
function TSprite.GetWorldX: Double;
847
begin
4 daniel-mar 848
  if Parent <> nil then
849
    Result := Parent.WorldX + FX
1 daniel-mar 850
  else
851
    Result := FX;
852
end;
853
 
854
function TSprite.GetWorldY: Double;
855
begin
4 daniel-mar 856
  if Parent <> nil then
857
    Result := Parent.WorldY + FY
1 daniel-mar 858
  else
859
    Result := FY;
860
end;
861
 
862
procedure TSprite.SetZ(Value: Integer);
863
begin
4 daniel-mar 864
  if FZ <> Value then
1 daniel-mar 865
  begin
866
    FZ := Value;
4 daniel-mar 867
    if Parent <> nil then
1 daniel-mar 868
    begin
869
      Parent.FDrawList.Remove(Self);
870
      Parent.AddDrawList(Self);
871
    end;
872
  end;
873
end;
874
 
4 daniel-mar 875
procedure TSprite.Assign(Source: TPersistent);
876
begin
877
  if Source is TSprite then
878
  begin
879
    FCollisioned := TSprite(Source).FCollisioned;
880
    FMoved := TSprite(Source).FMoved;
881
    FVisible := TSprite(Source).FVisible;
882
    FHeight := TSprite(Source).FHeight;
883
    FWidth := TSprite(Source).FWidth;
884
    FX := TSprite(Source).FX;
885
    FY := TSprite(Source).FY;
886
    FZ := TSprite(Source).FZ;
887
{$IFDEF Ver4Up}
888
    FSelected := TSprite(Source).FSelected;
889
    FGroupNumber := TSprite(Source).FGroupNumber;
890
{$ENDIF}
891
    {copy image base - when exists}
892
    FDXImage := TSprite(Source).FDXImage;
893
    FDXImageName := TSprite(Source).FDXImageName;
894
    FDXImageList := TSprite(Source).FDXImageList;
895
    {events}
896
    FOnDraw := TSprite(Source).FOnDraw;
897
    FOnMove := TSprite(Source).FOnMove;
898
    FOnCollision := TSprite(Source).FOnCollision;
899
    FOnGetImage := TSprite(Source).FOnGetImage;
900
  end
901
  else
902
    inherited;
903
end;
904
 
905
procedure TSprite.ReAnimate(MoveCount: Integer);
906
begin
907
 
908
end;
909
 
1 daniel-mar 910
{  TImageSprite  }
911
 
912
constructor TImageSprite.Create(AParent: TSprite);
913
begin
914
  inherited Create(AParent);
915
  FTransparent := True;
4 daniel-mar 916
  FAlpha := 255;
917
  FAngle := 0;
918
  FBlendMode := rtDraw;
919
  FCenterX := 0.5;
920
  FCenterY := 0.5;
921
  FBlurImage := False;
922
  FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0);
923
  FTextureFilter := D2D_POINT;
1 daniel-mar 924
end;
925
 
4 daniel-mar 926
procedure TImageSprite.SetImage(AImage: TPictureCollectionItem);
927
begin
928
  FDXImage := AImage;
929
  FDXImageName := '';
930
  if AImage <> nil then
931
  begin
932
    Width := AImage.Width;
933
    Height := AImage.Height;
934
    FDXImageName := FDXImage.Name;
935
  end
936
  else
937
  begin
938
    Width := 0;
939
    Height := 0;
940
  end;
941
end; {SetImage}
942
 
1 daniel-mar 943
function TImageSprite.GetBoundsRect: TRect;
944
var
945
  dx, dy: Integer;
946
begin
4 daniel-mar 947
  dx := Round(WorldX);
948
  dy := Round(WorldY);
1 daniel-mar 949
  if FTile then
950
  begin
4 daniel-mar 951
    dx := Mod2(dx, FEngine.SurfaceRect.Right + Width);
952
    dy := Mod2(dy, FEngine.SurfaceRect.Bottom + Height);
1 daniel-mar 953
 
4 daniel-mar 954
    if dx > FEngine.SurfaceRect.Right then
955
      dx := (dx - FEngine.SurfaceRect.Right) - Width;
1 daniel-mar 956
 
4 daniel-mar 957
    if dy > FEngine.SurfaceRect.Bottom then
958
      dy := (dy - FEngine.SurfaceRect.Bottom) - Height;
1 daniel-mar 959
  end;
960
 
961
  Result := Bounds(dx, dy, Width, Height);
962
end;
963
 
964
procedure TImageSprite.DoMove(MoveCount: Integer);
965
begin
4 daniel-mar 966
  if AsSigned(FOnMove) then
967
    FOnMove(Self, MoveCount)
968
  else
1 daniel-mar 969
  begin
4 daniel-mar 970
    ReAnimate(MoveCount);
1 daniel-mar 971
  end;
972
end;
973
 
974
function TImageSprite.GetDrawImageIndex: Integer;
975
begin
4 daniel-mar 976
  Result := FAnimStart + Trunc(FAnimPos); //solve 1.07f to Round()
1 daniel-mar 977
end;
978
 
979
function TImageSprite.GetDrawRect: TRect;
980
begin
981
  Result := BoundsRect;
4 daniel-mar 982
  OffsetRect(Result, (Width - Image.Width) div 2, (Height - Image.Height) div 2);
1 daniel-mar 983
end;
984
 
4 daniel-mar 985
procedure TImageSprite.LoadImage;
986
var
987
 vImage: TPictureCollectionItem;
988
begin
989
  if Image = nil then
990
    if AsSigned(FOnGetImage) then
991
    begin
992
      vImage := nil;
993
      FOnGetImage(Self, vImage);
994
      if vImage <> Image then
995
        Image := vImage;
996
    end
997
    else
998
      if FDXImageName <> '' then
999
        if Assigned(FDXImageList) then
1000
        begin
1001
          Image := FDXImageList.Items.Find(FDXImageName);
1002
        end;
1003
end;
1004
 
1 daniel-mar 1005
procedure TImageSprite.DoDraw;
1006
var
1007
  r: TRect;
1008
begin
4 daniel-mar 1009
  LoadImage;
1010
  if Image = nil then
1011
    Exit;
1012
  if AsSigned(FOnDraw) then {owner draw called here}
1013
    FOnDraw(Self)
1014
  else {when is not owner draw then go here}
1015
  begin
1016
    r := Bounds(Round(WorldX), Round(WorldY), Width, Height);
1017
    {New function implemented}
1018
    if Assigned(FEngine.FOwner) then
1019
      DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, r, GetDrawImageIndex,
1020
        FBlurImageArr, FBlurImage, FTextureFilter, FMirrorFlip, FBlendMode, FAngle,
1021
        FAlpha, FCenterX, FCenterY);
1022
  end;
1 daniel-mar 1023
end;
1024
 
4 daniel-mar 1025
{$WARNINGS OFF}
1026
{$HINTS OFF}
1 daniel-mar 1027
 
4 daniel-mar 1028
function TImageSprite.ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
1029
  const rect1, rect2: TRect; x1, y1, x2, y2: Integer; DoPixelCheck: Boolean): Boolean;
1030
 
1 daniel-mar 1031
  function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
1032
  begin
1033
    with DestRect do
1034
    begin
1035
      Left := Max(Left, DestRect2.Left);
1036
      Right := Min(Right, DestRect2.Right);
1037
      Top := Max(Top, DestRect2.Top);
1038
      Bottom := Min(Bottom, DestRect2.Bottom);
1039
 
1040
      Result := (Left < Right) and (Top < Bottom);
1041
    end;
1042
  end;
1043
 
1044
type
1045
  PRGB = ^TRGB;
4 daniel-mar 1046
 
1 daniel-mar 1047
  TRGB = packed record
4 daniel-mar 1048
    R, G, B: byte;
1 daniel-mar 1049
  end;
1050
var
4 daniel-mar 1051
  ddsd1, ddsd2: {$IFDEF D3D_deprecated}TDDSURFACEDESC{$ELSE}TDDSurfaceDesc2{$ENDIF};
1052
  r1, r2, r1a, r2a: TRect;
1 daniel-mar 1053
  tc1, tc2: DWORD;
1054
  x, y, w, h: Integer;
1055
  P1, P2: Pointer;
1056
begin
4 daniel-mar 1057
  with rect1 do
1058
    r1 := Bounds(0, 0, Right - Left, Bottom - Top);
1059
  r1a := r1;
1060
  with rect2 do
1061
    r2 := Bounds(0, 0, Right - Left, Bottom - Top);
1062
  r2a := r2;
1 daniel-mar 1063
 
4 daniel-mar 1064
  with rect2 do
1065
    r2 := Bounds(x2 - x1, y2 - y1, Right - Left, Bottom - Top);
1066
 
1 daniel-mar 1067
  Result := OverlapRect(r1, r2);
1068
 
4 daniel-mar 1069
  if (suf1 = nil) or (suf2 = nil) then
1070
    Exit;
1 daniel-mar 1071
 
1072
  if DoPixelCheck and Result then
1073
  begin
1074
    {  Get Overlapping rectangle  }
4 daniel-mar 1075
    with r1 do
1076
      r1 := Bounds(Max(x2 - x1, 0), Max(y2 - y1, 0), Right - Left, Bottom - Top);
1077
    with r2 do
1078
      r2 := Bounds(Max(x1 - x2, 0), Max(y1 - y2, 0), Right - Left, Bottom - Top);
1 daniel-mar 1079
 
4 daniel-mar 1080
    ClipRect(r1, r1a);
1081
    ClipRect(r2, r2a);
1 daniel-mar 1082
 
4 daniel-mar 1083
    w := Min(r1.Right - r1.Left, r2.Right - r2.Left);
1084
    h := Min(r1.Bottom - r1.Top, r2.Bottom - r2.Top);
1 daniel-mar 1085
 
1086
    ClipRect(r1, bounds(r1.Left, r1.Top, w, h));
1087
    ClipRect(r2, bounds(r2.Left, r2.Top, w, h));
4 daniel-mar 1088
 
1 daniel-mar 1089
    {  Pixel check !!!  }
1090
    ddsd1.dwSize := SizeOf(ddsd1);
4 daniel-mar 1091
 
1092
    with rect1 do
1093
      r1 := Bounds(r1.Left + left, r1.Top + top, w, h);
1094
    with rect2 do
1095
      r2 := Bounds(r2.Left + left, r2.Top + top, w, h);
1096
 
1097
    if suf1 = suf2 then
1098
    begin
1099
      suf2.Lock(r2, ddsd2);
1100
      suf2.unlock;
1101
    end;
1102
 
1 daniel-mar 1103
    if suf1.Lock(r1, ddsd1) then
1104
    begin
1105
      try
1106
        ddsd2.dwSize := SizeOf(ddsd2);
4 daniel-mar 1107
        if (suf1 = suf2) or suf2.Lock(r2, ddsd2) then
1 daniel-mar 1108
        begin
1109
          try
4 daniel-mar 1110
            {this line out: don't test pixel but rect only, its wrong}
1111
            {if suf1=suf2 then ddsd2 := ddsd1;}
1112
            if ddsd1.ddpfPixelFormat.dwRGBBitCount <> ddsd2.ddpfPixelFormat.dwRGBBitCount then
1113
              Exit;
1114
 
1 daniel-mar 1115
            {  Get transparent color  }
1116
            tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
1117
            tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;
1118
 
1119
            case ddsd1.ddpfPixelFormat.dwRGBBitCount of
4 daniel-mar 1120
              8:
1121
                begin
1122
                  for y := 0 to h - 1 do
1123
                  begin
1124
                    P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
1125
                    P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
1126
                    for x := 0 to w - 1 do
1 daniel-mar 1127
                    begin
4 daniel-mar 1128
                      if (PByte(P1)^ <> tc1) and (PByte(P2)^ <> tc2) then
1129
                        Exit;
1130
                      Inc(PByte(P1));
1131
                      Inc(PByte(P2));
1 daniel-mar 1132
                    end;
1133
                  end;
4 daniel-mar 1134
                end;
1135
              16:
1136
                begin
1137
                  for y := 0 to h - 1 do
1138
                  begin
1139
                    P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
1140
                    P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
1141
                    for x := 0 to w - 1 do
1 daniel-mar 1142
                    begin
4 daniel-mar 1143
                      if (PWord(P1)^ <> tc1) and (PWord(P2)^ <> tc2) then
1144
                        Exit;
1145
                      Inc(PWord(P1));
1146
                      Inc(PWord(P2));
1 daniel-mar 1147
                    end;
1148
                  end;
4 daniel-mar 1149
                end;
1150
              24:
1151
                begin
1152
                  for y := 0 to h - 1 do
1153
                  begin
1154
                    P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
1155
                    P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
1156
                    for x := 0 to w - 1 do
1 daniel-mar 1157
                    begin
4 daniel-mar 1158
                      with PRGB(P1)^ do
1159
                        if (R shl 16) or (G shl 8) or B <> tc1 then
1160
                          Exit;
1161
                      with PRGB(P2)^ do
1162
                        if (R shl 16) or (G shl 8) or B <> tc2 then
1163
                          Exit;
1164
                      Inc(PRGB(P1));
1165
                      Inc(PRGB(P2));
1 daniel-mar 1166
                    end;
1167
                  end;
4 daniel-mar 1168
                end;
1169
              32:
1170
                begin
1171
                  for y := 0 to h - 1 do
1172
                  begin
1173
                    P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
1174
                    P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
1175
                    for x := 0 to w - 1 do
1 daniel-mar 1176
                    begin
4 daniel-mar 1177
                      if (PDWORD(P1)^ <> tc1) and (PDWORD(P2)^ <> tc2) then
1178
                        Exit;
1179
                      Inc(PDWORD(P1));
1180
                      Inc(PDWORD(P2));
1 daniel-mar 1181
                    end;
1182
                  end;
4 daniel-mar 1183
                end;
1 daniel-mar 1184
            end;
1185
          finally
4 daniel-mar 1186
            if suf1 <> suf2 then
1187
              suf2.UnLock;
1 daniel-mar 1188
          end;
1189
        end;
1190
      finally
1191
        suf1.UnLock;
1192
      end;
1193
    end;
1194
 
1195
    Result := False;
1196
  end;
1197
end;
1198
 
4 daniel-mar 1199
{$HINTS ON}
1200
{$WARNINGS ON}
1201
 
1 daniel-mar 1202
function TImageSprite.TestCollision(Sprite: TSprite): Boolean;
1203
var
1204
  img1, img2: Integer;
4 daniel-mar 1205
  box1, box2: TRect;
1 daniel-mar 1206
begin
4 daniel-mar 1207
  if (Sprite is TImageSprite) then
1208
    if FPixelCheck then
1209
    begin
1210
      box1 := GetDrawRect;
1211
      box2 := TImageSprite(Sprite).GetDrawRect;
1 daniel-mar 1212
 
4 daniel-mar 1213
      img1 := GetDrawImageIndex;
1214
      img2 := TImageSprite(Sprite).GetDrawImageIndex;
1 daniel-mar 1215
 
4 daniel-mar 1216
      Result := ImageCollisionTest(Image.PatternSurfaces[img1],
1217
        TImageSprite(Sprite).Image.PatternSurfaces[img2], Image.PatternRects[img1],
1218
        TImageSprite(Sprite).Image.PatternRects[img2], box1.Left, box1.Top,
1219
        box2.Left, box2.Top, True);
1220
    end
1221
    else
1222
      Result := OverlapRect(Bounds(Round(Sprite.WorldX), Round(Sprite.WorldY),
1223
        Sprite.Width, Sprite.Height), Bounds(Round(WorldX), Round(WorldY), Width, Height))
1224
  else
1 daniel-mar 1225
    Result := inherited TestCollision(Sprite);
1226
end;
1227
 
4 daniel-mar 1228
procedure TImageSprite.Assign(Source: TPersistent);
1 daniel-mar 1229
begin
4 daniel-mar 1230
  if Source is TImageSprite then begin
1231
    FCenterX := TImageSprite(Source).FCenterX;
1232
    FCenterY := TImageSprite(Source).FCenterY;
1233
    FAnimCount := TImageSprite(Source).FAnimCount;
1234
    FAnimLooped := TImageSprite(Source).FAnimLooped;
1235
    FAnimPos := TImageSprite(Source).FAnimPos;
1236
    FAnimSpeed := TImageSprite(Source).FAnimSpeed;
1237
    FAnimStart := TImageSprite(Source).FAnimStart;
1238
    FDXImage := TImageSprite(Source).FDXImage;
1239
    FPixelCheck := TImageSprite(Source).FPixelCheck;
1240
    FTile := TImageSprite(Source).FTile;
1241
    FTransparent := TImageSprite(Source).FTransparent;
1242
    FAngle := TImageSprite(Source).FAngle;
1243
    FAlpha := TImageSprite(Source).FAlpha;
1244
    FBlendMode := TImageSprite(Source).FBlendMode;
1245
    FBlurImage := TImageSprite(Source).FBlurImage;
1246
  end;
1247
  inherited;
1 daniel-mar 1248
end;
1249
 
4 daniel-mar 1250
procedure TImageSprite.ReAnimate(MoveCount: Integer);
1 daniel-mar 1251
var
4 daniel-mar 1252
  I: Integer;
1 daniel-mar 1253
begin
4 daniel-mar 1254
  FAnimPos := FAnimPos + FAnimSpeed * MoveCount;
1 daniel-mar 1255
 
4 daniel-mar 1256
  if FAnimLooped then
1 daniel-mar 1257
  begin
4 daniel-mar 1258
    if FAnimCount > 0 then
1259
      FAnimPos := Mod2f(FAnimPos, FAnimCount)
1260
    else
1261
      FAnimPos := 0;
1262
  end
1263
  else
1264
  begin
1265
    if Round(FAnimPos) >= FAnimCount then
1 daniel-mar 1266
    begin
4 daniel-mar 1267
      FAnimPos := FAnimCount - 1;
1268
      FAnimSpeed := 0;
1269
    end;
1270
    if FAnimPos < 0 then
1 daniel-mar 1271
    begin
4 daniel-mar 1272
      FAnimPos := 0;
1273
      FAnimSpeed := 0;
1 daniel-mar 1274
    end;
4 daniel-mar 1275
  end;
1276
  if FBlurImage then
1 daniel-mar 1277
  begin
4 daniel-mar 1278
    {ale jen jsou-li jine souradnice}
1279
    if (FBlurImageArr[High(FBlurImageArr)].eX <> Round(WorldX)) or
1280
    (FBlurImageArr[High(FBlurImageArr)].eY <> Round(WorldY)) then
1 daniel-mar 1281
    begin
4 daniel-mar 1282
      for i := Low(FBlurImageArr) + 1 to High(FBlurImageArr) do
1283
      begin
1284
        FBlurImageArr[i - 1] := FBlurImageArr[i];
1285
        {adjust the blur intensity}
1286
        FBlurImageArr[i - 1].eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * (i - 1);
1287
      end;
1288
      with FBlurImageArr[High(FBlurImageArr)] do
1289
      begin
1290
        eX := Round(WorldX);
1291
        eY := Round(WorldY);
1292
        ePatternIndex := GetDrawImageIndex;
1293
        eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * High(FBlurImageArr);
1294
        eBlendMode := FBlendMode;
1295
        eActive := True;
1296
      end;
1 daniel-mar 1297
    end;
1298
  end;
1299
end;
1300
 
4 daniel-mar 1301
function TImageSprite.StoreCenterX: Boolean;
1 daniel-mar 1302
begin
4 daniel-mar 1303
  Result := FCenterX <> 0.5;
1 daniel-mar 1304
end;
1305
 
4 daniel-mar 1306
function TImageSprite.StoreCenterY: Boolean;
1 daniel-mar 1307
begin
4 daniel-mar 1308
  Result := FCenterY <> 0.5;
1309
end;
1310
 
1311
function TImageSprite.StoreAlpha: Boolean;
1312
begin
1313
  Result := FAlpha <> 0.0;
1314
end;
1315
 
1316
procedure TImageSprite.DefineProperties(Filer: TFiler);
1317
begin
1318
  inherited DefineProperties(Filer);
1319
  Filer.DefineProperty('BlendMode', ReadBlendMode, WriteBlendMode, FBlendMode <> rtDraw);
1320
  Filer.DefineProperty('Angle', ReadAngle, WriteAngle, FAngle <> 0);
1321
  Filer.DefineProperty('CenterX', ReadCenterX, WriteCenterX, FCenterX <> 0.5);
1322
  Filer.DefineProperty('CenterY', ReadCenterY, WriteCenterY, FCenterY <> 0.5);
1323
  Filer.DefineProperty('Alpha', ReadAlpha, WriteAlpha, FAlpha <> $FF);
1324
  Filer.DefineProperty('AnimCount', ReadAnimCount, WriteAnimCount, FAnimCount <> 0);
1325
  Filer.DefineProperty('AnimLooped', ReadAnimLooped, WriteAnimLooped, FAnimLooped);
1326
  Filer.DefineProperty('AnimPos', ReadAnimPos, WriteAnimPos, FAnimPos <> 0);
1327
  Filer.DefineProperty('AnimSpeed', ReadAnimSpeed, WriteAnimSpeed, FAnimSpeed <> 0);
1328
  Filer.DefineProperty('AnimStart', ReadAnimStart, WriteAnimStart, True);
1329
  Filer.DefineProperty('PixelCheck', ReadPixelCheck, WritePixelCheck, FPixelCheck);
1330
  Filer.DefineProperty('Tile', ReadTile, WriteTile, FTile);
1331
  Filer.DefineProperty('BlurImage', ReadBlurImage, WriteBlurImage, FBlurImage);
1332
  Filer.DefineProperty('MirrorFlip', ReadMirrorFlip, WriteMirrorFlip, FMirrorFlip <> []);
1333
  Filer.DefineProperty('TextureFilter', ReadTextureFilter, WriteTextureFilter, FTextureFilter <> D2D_POINT);
1334
end;
1335
 
1336
procedure TImageSprite.WriteMirrorFlip(Writer: TWriter);
1337
var
1338
  q: TRenderMirrorFlip;
1339
  s, ss: string;
1340
//  I: Integer;
1341
  //PI: PPropInfo;
1342
begin
1343
//  PI := GetPropInfo(Self,'MirrorFlip');
1344
//  I := Integer(FMirrorFlip);
1345
  s := '[]'; ss := '';
1346
  for q := Low(TRenderMirrorFlip) to High(TRenderMirrorFlip) do
1347
    if q in FMirrorFlip then
1348
      ss := ss + GetEnumName(TypeInfo(TRenderMirrorFlip), Ord(q)) + ', ';
1349
  if ss <> '' then
1350
    s := '[' + Copy(ss, 1, Length(ss) - 2) + ']';
1351
  Writer.WriteString(s);
1352
//---  Writer.WriteString(SetToString(PI, GetOrdProp(Self, PI), True));
1353
end;
1354
 
1355
procedure TImageSprite.ReadMirrorFlip(Reader: TReader);
1356
var
1357
  q: TRenderMirrorFlip;
1358
  qq: TRenderMirrorFlipSet;
1359
  s {, ss}: string;
1360
//  PI: PPropInfo;
1361
begin
1362
//  PI := GetPropInfo(Self,'MirrorFlip');
1363
//  SetOrdProp(Self,PI,StringToSet(PI, Reader.ReadString));
1364
  qq := [];
1365
  s := Reader.ReadString;
1366
  for q := Low(TRenderMirrorFlip) to High(TRenderMirrorFlip) do
1367
    if Pos(GetEnumName(TypeInfo(TRenderMirrorFlip), Ord(q)), s) <> 0 then
1368
      qq := qq + [q];
1369
  FMirrorFlip := qq;
1370
end;
1371
 
1372
procedure TImageSprite.ReadAnimLooped(Reader: TReader);
1373
begin
1374
  FAnimLooped := Reader.ReadBoolean;
1375
end;
1376
 
1377
procedure TImageSprite.WriteAnimLooped(Writer: TWriter);
1378
begin
1379
  Writer.WriteBoolean(FAnimLooped);
1380
end;
1381
 
1382
procedure TImageSprite.ReadAnimPos(Reader: TReader);
1383
begin
1384
  FAnimPos := Reader.ReadFloat;
1385
end;
1386
 
1387
procedure TImageSprite.WriteAnimPos(Writer: TWriter);
1388
begin
1389
  Writer.WriteFloat(FAnimPos);
1390
end;
1391
 
1392
procedure TImageSprite.ReadAnimSpeed(Reader: TReader);
1393
begin
1394
  FAnimSpeed := Reader.ReadFloat;
1395
end;
1396
 
1397
procedure TImageSprite.WriteAnimSpeed(Writer: TWriter);
1398
begin
1399
  Writer.WriteFloat(FAnimSpeed);
1400
end;
1401
 
1402
procedure TImageSprite.ReadAnimStart(Reader: TReader);
1403
begin
1404
  FAnimStart := Reader.ReadInteger;
1405
end;
1406
 
1407
procedure TImageSprite.WriteAnimStart(Writer: TWriter);
1408
begin
1409
  Writer.WriteInteger(FAnimStart);
1410
end;
1411
 
1412
procedure TImageSprite.ReadPixelCheck(Reader: TReader);
1413
begin
1414
  FPixelCheck := Reader.ReadBoolean;
1415
end;
1416
 
1417
procedure TImageSprite.WritePixelCheck(Writer: TWriter);
1418
begin
1419
  Writer.WriteBoolean(FPixelCheck);
1420
end;
1421
 
1422
procedure TImageSprite.ReadTile(Reader: TReader);
1423
begin
1424
  FTile := Reader.ReadBoolean;
1425
end;
1426
 
1427
procedure TImageSprite.WriteTile(Writer: TWriter);
1428
begin
1429
  Writer.WriteBoolean(FTile);
1430
end;
1431
 
1432
procedure TImageSprite.ReadAnimCount(Reader: TReader);
1433
begin
1434
  FAnimCount := Reader.ReadInteger;
1435
end;
1436
 
1437
procedure TImageSprite.WriteAnimCount(Writer: TWriter);
1438
begin
1439
  Writer.WriteInteger(FAnimCount);
1440
end;
1441
 
1442
procedure TImageSprite.ReadAlpha(Reader: TReader);
1443
begin
1444
  FAlpha := Reader.ReadInteger;
1445
end;
1446
 
1447
procedure TImageSprite.WriteAlpha(Writer: TWriter);
1448
begin
1449
  Writer.WriteInteger(FAlpha);
1450
end;
1451
 
1452
procedure TImageSprite.ReadCenterY(Reader: TReader);
1453
begin
1454
  FCenterY := Reader.ReadFloat;
1455
end;
1456
 
1457
procedure TImageSprite.WriteCenterY(Writer: TWriter);
1458
begin
1459
  Writer.WriteFloat(FCenterY);
1460
end;
1461
 
1462
procedure TImageSprite.ReadCenterX(Reader: TReader);
1463
begin
1464
  FCenterX := Reader.ReadFloat;
1465
end;
1466
 
1467
procedure TImageSprite.WriteCenterX(Writer: TWriter);
1468
begin
1469
  Writer.WriteFloat(FCenterX);
1470
end;
1471
 
1472
procedure TImageSprite.ReadAngle(Reader: TReader);
1473
begin
1474
  FAngle := Reader.{$IFDEF VER4UP}ReadSingle{$ELSE}ReadFloat{$ENDIF};
1475
end;
1476
 
1477
procedure TImageSprite.WriteAngle(Writer: TWriter);
1478
begin
1479
  Writer.{$IFDEF VER4UP}WriteSingle{$ELSE}WriteFloat{$ENDIF}(FAngle);
1480
end;
1481
 
1482
procedure TImageSprite.ReadBlendMode(Reader: TReader);
1483
begin
1484
  FBlendMode := TRenderType(GetEnumValue(TypeInfo(TRenderType), Reader.ReadString));
1485
end;
1486
 
1487
procedure TImageSprite.WriteBlendMode(Writer: TWriter);
1488
begin
1489
  Writer.WriteString(GetEnumName(TypeInfo(TRenderType), Ord(FBlendMode)));
1490
end;
1491
 
1492
procedure TImageSprite.ReadBlurImage(Reader: TReader);
1493
begin
1494
  FBlurImage := Reader.ReadBoolean;
1495
end;
1496
 
1497
procedure TImageSprite.WriteBlurImage(Writer: TWriter);
1498
begin
1499
  Writer.WriteBoolean(FBlurImage);
1500
end;
1501
 
1502
procedure TImageSprite.ReadTextureFilter(Reader: TReader);
1503
begin
1504
  FTextureFilter := TD2DTextureFilter(Reader.ReadInteger);
1505
end;
1506
 
1507
procedure TImageSprite.WriteTextureFilter(Writer: TWriter);
1508
begin
1509
  Writer.WriteInteger(Ord(FTextureFilter));
1510
end;
1511
 
1512
procedure TImageSprite.SetBlurImageArr(const Value: TBlurImageArr);
1513
begin
1514
  FBlurImageArr := Value;
1515
end;
1516
 
1517
procedure TImageSprite.SetBlurImage(const Value: Boolean);
1518
begin
1519
  if (FBlurImage <> Value) and (Value) then
1 daniel-mar 1520
  begin
4 daniel-mar 1521
    FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0); //get out when set up
1 daniel-mar 1522
  end;
4 daniel-mar 1523
  FBlurImage := Value;
1 daniel-mar 1524
end;
1525
 
4 daniel-mar 1526
function TImageSprite.GetImage: TPictureCollectionItem;
1527
begin
1528
  Result := FDXImage;
1529
end;
1530
 
1531
procedure TImageSprite.SetMirrorFlip(const Value: TRenderMirrorFlipSet);
1532
begin
1533
  FMirrorFlip := Value;
1534
end;
1535
 
1 daniel-mar 1536
{  TBackgroundSprite  }
1537
 
1538
constructor TBackgroundSprite.Create(AParent: TSprite);
1539
begin
1540
  inherited Create(AParent);
4 daniel-mar 1541
  FMap := nil;
1542
  FMapWidth := 0;
1543
  FMapHeight := 0;
1 daniel-mar 1544
  Collisioned := False;
1545
end;
1546
 
1547
destructor TBackgroundSprite.Destroy;
1548
begin
1549
  SetMapSize(0, 0);
1550
  inherited Destroy;
1551
end;
1552
 
4 daniel-mar 1553
procedure TBackgroundSprite.ChipsDraw(Image: TPictureCollectionItem; X, Y: Integer; PatternIndex: Integer);
1554
begin
1555
  if AsSigned(FOnDraw) then
1556
    FOnDraw(Self)
1557
  else
1558
  begin
1559
    //Image.Draw(FEngine.Surface, X, Y, PatternIndex);
1560
    {New function implemented}
1561
    if Assigned(FEngine.FOwner) then
1562
      //Image.DrawAlpha(DXDraw1.Surface,ChipsRect,ChipsPatternIndex,Blend);
1563
      DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, ChipsRect, ChipsPatternIndex,
1564
        FBlurImageArr, FBlurImage, FTextureFilter, FMirrorFlip, FBlendMode, FAngle,
1565
        Map[X,Y].Alpha, FCenterX, FCenterY);
1566
  end;
1567
end;
1568
 
1 daniel-mar 1569
procedure TBackgroundSprite.DoDraw;
1570
var
4 daniel-mar 1571
  TmpX, TmpY, cx, cy, cx2, cy2, PatternIndex, ChipWidth, ChipHeight: Integer;
1 daniel-mar 1572
  StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer;
1573
  r: TRect;
4 daniel-mar 1574
  Q: TMapType;
1 daniel-mar 1575
begin
4 daniel-mar 1576
  LoadImage;
1577
  if Image = nil then
1578
    Exit;
1 daniel-mar 1579
 
4 daniel-mar 1580
  if (FMapWidth <= 0) or (FMapHeight <= 0) then
1581
    Exit;
1 daniel-mar 1582
 
1583
  r := Image.PatternRects[0];
4 daniel-mar 1584
  ChipWidth := r.Right - r.Left;
1585
  ChipHeight := r.Bottom - r.Top;
1 daniel-mar 1586
 
4 daniel-mar 1587
  dWidth := (FEngine.SurfaceRect.Right + ChipWidth) div ChipWidth + 1;
1588
  dHeight := (FEngine.SurfaceRect.Bottom + ChipHeight) div ChipHeight + 1;
1 daniel-mar 1589
 
4 daniel-mar 1590
  TmpX := Round(WorldX);
1591
  TmpY := Round(WorldY);
1 daniel-mar 1592
 
4 daniel-mar 1593
  OfsX := TmpX mod ChipWidth;
1594
  OfsY := TmpY mod ChipHeight;
1 daniel-mar 1595
 
4 daniel-mar 1596
  StartX := TmpX div ChipWidth;
1 daniel-mar 1597
  StartX_ := 0;
1598
 
4 daniel-mar 1599
  if StartX < 0 then
1 daniel-mar 1600
  begin
1601
    StartX_ := -StartX;
1602
    StartX := 0;
1603
  end;
1604
 
4 daniel-mar 1605
  StartY := TmpY div ChipHeight;
1 daniel-mar 1606
  StartY_ := 0;
1607
 
4 daniel-mar 1608
  if StartY < 0 then
1 daniel-mar 1609
  begin
1610
    StartY_ := -StartY;
1611
    StartY := 0;
1612
  end;
1613
 
4 daniel-mar 1614
  EndX := Min(StartX + FMapWidth - StartX_, dWidth);
1615
  EndY := Min(StartY + FMapHeight - StartY_, dHeight);
1 daniel-mar 1616
 
1617
  if FTile then
1618
  begin
4 daniel-mar 1619
    for cy := -1 to dHeight do
1 daniel-mar 1620
    begin
4 daniel-mar 1621
      cy2 := Mod2((cy - StartY + StartY_), FMapHeight);
1622
      for cx := -1 to dWidth do
1 daniel-mar 1623
      begin
4 daniel-mar 1624
        cx2 := Mod2((cx - StartX + StartX_), FMapWidth);
1625
        PatternIndex := Chips[cx2, cy2];
1626
        ChipsPatternIndex := PatternIndex; //refresh only
1627
        ChipsRect := Bounds(cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, ChipWidth, ChipHeight);
1628
        if PatternIndex >= 0 then
1629
        begin
1630
          if AsSigned(FOnDraw) then
1631
            FOnDraw(Self)
1632
          else
1633
          begin
1634
            {New function implemented}
1635
            if Assigned(FEngine.FOwner) then
1636
            begin
1637
              Q := Map[cx2,cy2];
1638
              DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, ChipsRect, Q.MapChip,
1639
                FBlurImageArr, FBlurImage, Q.TextureFilter, Q.MirrorFlip, Q.Rendered, Q.Angle,
1640
                Q.Alpha, Q.CenterX, Q.CenterY);
1641
            end;
1642
          end;
1643
        end;
1 daniel-mar 1644
      end;
1645
    end;
4 daniel-mar 1646
  end
1647
  else
1 daniel-mar 1648
  begin
4 daniel-mar 1649
    for cy := StartY to EndY - 1 do
1650
      for cx := StartX to EndX - 1 do
1 daniel-mar 1651
      begin
4 daniel-mar 1652
        PatternIndex := Chips[cx - StartX + StartX_, cy - StartY + StartY_];
1653
        ChipsPatternIndex := PatternIndex; //refresh only
1654
        ChipsRect := Bounds(cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, ChipWidth, ChipHeight);
1655
        if PatternIndex >= 0 then
1656
        begin
1657
          if AsSigned(FOnDraw) then
1658
            FOnDraw(Self)
1659
          else
1660
          begin
1661
            {New function implemented}
1662
            if Assigned(FEngine.FOwner) then
1663
            begin
1664
              Q := Map[cx,cy];
1665
              DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, ChipsRect, Q.MapChip,
1666
                FBlurImageArr, FBlurImage, Q.TextureFilter, Q.MirrorFlip, Q.Rendered, Q.Angle,
1667
                Q.Alpha, Q.CenterX, Q.CenterY);
1668
            end;
1669
          end;
1670
        end
1 daniel-mar 1671
      end;
4 daniel-mar 1672
  end;
1 daniel-mar 1673
end;
1674
 
1675
function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean;
1676
var
4 daniel-mar 1677
  box0, box1, box2: TRect;
1 daniel-mar 1678
  cx, cy, ChipWidth, ChipHeight: Integer;
1679
  r: TRect;
1680
begin
1681
  Result := True;
4 daniel-mar 1682
  if Image = nil then
1683
    Exit;
1684
  if (FMapWidth <= 0) or (FMapHeight <= 0) then
1685
    Exit;
1 daniel-mar 1686
 
1687
  r := Image.PatternRects[0];
4 daniel-mar 1688
  ChipWidth := r.Right - r.Left;
1689
  ChipHeight := r.Bottom - r.Top;
1 daniel-mar 1690
 
4 daniel-mar 1691
  box1 := Sprite.BoundsRect;
1692
  box2 := BoundsRect;
1 daniel-mar 1693
 
4 daniel-mar 1694
  IntersectRect(box0, box1, box2);
1 daniel-mar 1695
 
4 daniel-mar 1696
  OffsetRect(box0, -Round(WorldX), -Round(WorldY));
1697
  OffsetRect(box1, -Round(WorldX), -Round(WorldY));
1 daniel-mar 1698
 
4 daniel-mar 1699
  for cy := (box0.Top - ChipHeight + 1) div ChipHeight to box0.Bottom div ChipHeight do
1700
    for cx := (box0.Left - ChipWidth + 1) div ChipWidth to box0.Right div ChipWidth do
1 daniel-mar 1701
      if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then
1702
      begin
4 daniel-mar 1703
        if OverlapRect(Bounds(cx * ChipWidth, cy * ChipHeight, ChipWidth,
1704
          ChipHeight), box1) then
1705
          Exit;
1 daniel-mar 1706
      end;
1707
 
1708
  Result := False;
1709
end;
1710
 
1711
function TBackgroundSprite.GetChip(X, Y: Integer): Integer;
1712
begin
4 daniel-mar 1713
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1714
    Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.MapChip
1 daniel-mar 1715
  else
1716
    Result := -1;
1717
end;
1718
 
1719
function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean;
1720
begin
4 daniel-mar 1721
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1722
    Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionChip
1 daniel-mar 1723
  else
1724
    Result := False;
1725
end;
1726
 
4 daniel-mar 1727
function TBackgroundSprite.GetCollisionRectItem(X, Y: Integer): TRect;
1728
begin
1729
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1730
    Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionRect
1731
  else
1732
    Result := Rect(0, 0, 0, 0);
1733
end;
1734
 
1735
function TBackgroundSprite.GetTagMap(X, Y: Integer): Integer;
1736
begin
1737
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1738
    Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Tag
1739
  else
1740
    Result := 0;
1741
end;
1742
 
1743
function TBackgroundSprite.GetMap(X, Y: Integer): TMapType;
1744
begin
1745
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1746
    Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^
1747
  else
1748
    FillChar(Result, SizeOf(Result), 0);
1749
end;
1750
 
1 daniel-mar 1751
function TBackgroundSprite.GetBoundsRect: TRect;
1752
begin
1753
  if FTile then
1754
    Result := FEngine.SurfaceRect
1755
  else
1756
  begin
4 daniel-mar 1757
    LoadImage;
1758
    if Image <> nil then
1759
      Result := Bounds(Round(WorldX), Round(WorldY), Image.Width * FMapWidth,
1760
        Image.Height * FMapHeight)
1 daniel-mar 1761
    else
1762
      Result := Rect(0, 0, 0, 0);
1763
  end;
1764
end;
1765
 
1766
procedure TBackgroundSprite.SetChip(X, Y: Integer; Value: Integer);
1767
begin
4 daniel-mar 1768
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1769
    PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.MapChip := Value;
1 daniel-mar 1770
end;
1771
 
1772
procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean);
1773
begin
4 daniel-mar 1774
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1775
    PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionChip := Value;
1 daniel-mar 1776
end;
1777
 
4 daniel-mar 1778
procedure TBackgroundSprite.SetCollisionRectItem(X, Y: Integer; Value: TRect);
1779
begin
1780
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1781
    PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionRect := Value;
1782
end;
1783
 
1784
procedure TBackgroundSprite.SetTagMap(X, Y: Integer; Value: Integer);
1785
begin
1786
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1787
    PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Tag := Value;
1788
end;
1789
 
1790
procedure TBackgroundSprite.SetMap(X, Y: Integer; Value: TMapType);
1791
begin
1792
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1793
    PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^ := Value;
1794
end;
1795
 
1 daniel-mar 1796
procedure TBackgroundSprite.SetMapHeight(Value: Integer);
1797
begin
1798
  SetMapSize(FMapWidth, Value);
1799
end;
1800
 
1801
procedure TBackgroundSprite.SetMapWidth(Value: Integer);
1802
begin
1803
  SetMapSize(Value, FMapHeight);
1804
end;
1805
 
4 daniel-mar 1806
procedure TBackgroundSprite.SetImage(Img: TPictureCollectionItem);
1807
begin
1808
  inherited SetImage(Img);
1809
  if Assigned(Img) then
1810
  begin
1811
    FWidth := FMapWidth * Img.Width;
1812
    FHeight := FMapHeight * Img.Height;
1813
  end
1814
  else
1815
  begin
1816
    FWidth := 0;
1817
    FHeight := 0;
1818
  end;
1819
end;
1820
 
1 daniel-mar 1821
procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer);
4 daniel-mar 1822
var I: Integer;
1 daniel-mar 1823
begin
4 daniel-mar 1824
  if (FMapWidth <> AMapWidth) or (FMapHeight <> AMapHeight) or (FMap = nil) then
1 daniel-mar 1825
  begin
4 daniel-mar 1826
    try
1827
      if (AMapWidth <= 0) or (AMapHeight <= 0) then
1828
      begin
1829
        FreeMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType)); FMap := nil;
1830
        AMapWidth := 0;
1831
        AMapHeight := 0;
1832
      end;
1833
      FMapWidth := AMapWidth;
1834
      FMapHeight := AMapHeight;
1835
      System.ReallocMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType));
1836
      if Assigned(FMap) then
1837
      begin
1838
        FillChar(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType), 0);
1839
        for I := 0 to FMapWidth * FMapHeight - 1 do
1840
          PMapType(Integer(FMap) + (I) * SizeOf(TMapType))^.CollisionChip := True;
1841
      end
1842
    except
1843
      FreeMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType));
1844
      FMap := nil;
1 daniel-mar 1845
    end;
4 daniel-mar 1846
  end
1847
end;
1 daniel-mar 1848
 
4 daniel-mar 1849
procedure TBackgroundSprite.Assign(Source: TPersistent);
1850
begin
1851
  if Source is TBackgroundSprite then
1852
  begin
1853
    FMapWidth := TBackgroundSprite(Source).FMapWidth;
1854
    FMapHeight := TBackgroundSprite(Source).FMapHeight;
1855
    FTile := TBackgroundSprite(Source).FTile;
1 daniel-mar 1856
  end;
4 daniel-mar 1857
  inherited;
1 daniel-mar 1858
end;
1859
 
4 daniel-mar 1860
procedure TBackgroundSprite.DefineProperties(Filer: TFiler);
1861
begin
1862
  inherited DefineProperties(Filer);
1863
  Filer.DefineBinaryProperty('Map', ReadMapData, WriteMapData, FMap <> nil);
1864
end;
1865
 
1866
type
1867
  TMapDataHeader = packed record
1868
    MapWidth: Integer;
1869
    MapHeight: Integer;
1870
  end;
1871
 
1872
procedure TBackgroundSprite.ReadMapData(Stream: TStream);
1873
var
1874
  Header: TMapDataHeader;
1875
begin
1876
  Stream.ReadBuffer(Header, SizeOf(Header));
1877
  FMapWidth := Header.MapWidth;
1878
  FMapHeight := Header.MapHeight;
1879
  SetMapSize(Header.MapWidth, Header.MapHeight);
1880
  if Assigned(FMap) and (Header.MapWidth > 0) and (Header.MapHeight > 0) then
1881
  begin
1882
    Stream.ReadBuffer(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType));
1883
  end;
1884
end;
1885
 
1886
procedure TBackgroundSprite.WriteMapData(Stream: TStream);
1887
var
1888
  Header: TMapDataHeader;
1889
begin
1890
  Header.MapWidth := FMapWidth;
1891
  Header.MapHeight := FMapHeight;
1892
  Stream.WriteBuffer(Header, SizeOf(Header));
1893
  if Assigned(FMap) then
1894
    Stream.WriteBuffer(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType));
1895
end;
1896
 
1897
function TBackgroundSprite.GetOverlap(X, Y: Integer): Integer;
1898
begin
1899
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1900
    Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Overlap
1901
  else
1902
    Result := 0;
1903
end;
1904
 
1905
procedure TBackgroundSprite.SetOverlap(X, Y: Integer; const Value: Integer);
1906
begin
1907
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
1908
    PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Overlap := Value;
1909
end;
1910
 
1911
function TBackgroundSprite.IsMapEmpty: Boolean;
1912
begin
1913
  Result := (FMap = nil) or (FMapWidth <= 0) or (FMapHeight <= 0);
1914
end;
1915
 
1 daniel-mar 1916
{  TSpriteEngine  }
1917
 
1918
constructor TSpriteEngine.Create(AParent: TSprite);
1919
begin
1920
  inherited Create(AParent);
1921
  FDeadList := TList.Create;
4 daniel-mar 1922
  // group handling
1923
{$IFDEF Ver4Up}
1924
  fCurrentSelected := Tlist.create;
1925
  GroupCount := 10;
1926
{$ENDIF}
1 daniel-mar 1927
end;
1928
 
1929
destructor TSpriteEngine.Destroy;
1930
begin
4 daniel-mar 1931
  // cleanup Group handling
1932
{$IFDEF Ver4Up}
1933
  ClearCurrent;
1934
  GroupCount := 0;
1935
{$ENDIF}
1 daniel-mar 1936
  FDeadList.Free;
1937
  inherited Destroy;
4 daniel-mar 1938
{$IFDEF Ver4Up}
1939
  fCurrentSelected.free;
1940
{$ENDIF}
1 daniel-mar 1941
end;
1942
 
4 daniel-mar 1943
procedure TSpriteEngine.Collisions;
1944
var
1945
  index: Integer;
1946
begin
1947
  for index := 0 to Count - 1 do
1948
    Items[index].Collision;
1949
end;
1950
{Collisions}
1951
{$IFDEF Ver4Up}
1952
 
1953
procedure TSpriteEngine.GroupSelect(const Area: TRect; Add: Boolean = False);
1954
begin
1955
  GroupSelect(Area, [Tsprite], Add);
1956
end; {GroupSelect}
1957
 
1958
procedure TSpriteEngine.GroupSelect(const Area: TRect; Filter: array of TSpriteClass; Add: Boolean = False);
1959
var
1960
  index, index2: Integer;
1961
  sprite: TSprite;
1962
begin
1963
  Assert(length(Filter) <> 0, 'Filter = []');
1964
  if not Add then
1965
    ClearCurrent;
1966
  if length(Filter) = 1 then
1967
  begin
1968
    for Index := 0 to Count - 1 do
1969
    begin
1970
      sprite := Items[Index];
1971
      if (sprite is Filter[0]) and OverlapRect(sprite.GetBoundsRect, Area) then
1972
        sprite.Selected := true;
1973
    end
1974
  end
1975
  else
1976
  begin
1977
    for Index := 0 to Count - 1 do
1978
    begin
1979
      sprite := Items[index];
1980
      for index2 := 0 to high(Filter) do
1981
        if (sprite is Filter[index2]) and OverlapRect(sprite.GetBoundsRect, Area) then
1982
        begin
1983
          sprite.Selected := true;
1984
          break;
1985
        end;
1986
    end
1987
  end;
1988
  fObjectsSelected := CurrentSelected.count <> 0;
1989
end; {GroupSelect}
1990
 
1991
function TSpriteEngine.Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = False): Tsprite;
1992
var
1993
  index, index2: Integer;
1994
begin
1995
  Assert(length(Filter) <> 0, 'Filter = []');
1996
  if not Add then
1997
    ClearCurrent;
1998
  // By searching the Drawlist in reverse
1999
  // we select the highest sprite if the sprit is under the point
2000
  assert(FDrawList <> nil, 'FDrawList = nil');
2001
  if length(Filter) = 1 then
2002
  begin
2003
    for Index := FDrawList.Count - 1 downto 0 do
2004
    begin
2005
      Result := FDrawList[Index];
2006
      if (Result is Filter[0]) and PointInRect(Point, Result.GetBoundsRect) then
2007
      begin
2008
        Result.Selected := true;
2009
        fObjectsSelected := CurrentSelected.count <> 0;
2010
        exit;
2011
      end;
2012
    end
2013
  end
2014
  else
2015
  begin
2016
    for Index := FDrawList.Count - 1 downto 0 do
2017
    begin
2018
      Result := FDrawList[index];
2019
      for index2 := 0 to high(Filter) do
2020
        if (Result is Filter[index2]) and PointInRect(Point, Result.GetBoundsRect) then
2021
        begin
2022
          Result.Selected := true;
2023
          fObjectsSelected := CurrentSelected.count <> 0;
2024
          exit;
2025
        end;
2026
    end
2027
  end;
2028
  Result := nil;
2029
end; {Select}
2030
 
2031
function TSpriteEngine.Select(Point: TPoint; Add: Boolean = False): TSprite;
2032
begin
2033
  Result := Select(Point, [Tsprite], Add);
2034
end; {Select}
2035
 
2036
procedure TSpriteEngine.ClearCurrent;
2037
begin
2038
  while CurrentSelected.count <> 0 do
2039
    TSprite(CurrentSelected[CurrentSelected.count - 1]).Selected := False;
2040
  fObjectsSelected := False;
2041
end; {ClearCurrent}
2042
 
2043
procedure TSpriteEngine.ClearGroup(GroupNumber: Integer);
2044
var
2045
  index: Integer;
2046
  Group: Tlist;
2047
begin
2048
  Group := Groups[GroupNumber];
2049
  if Group <> nil then
2050
    for index := 0 to Group.count - 1 do
2051
      TSprite(Group[index]).Selected := False;
2052
end; {ClearGroup}
2053
 
2054
procedure TSpriteEngine.CurrentToGroup(GroupNumber: Integer; Add: Boolean = False);
2055
var
2056
  Group: Tlist;
2057
  index: Integer;
2058
begin
2059
  Group := Groups[GroupNumber];
2060
  if Group = nil then
2061
    exit;
2062
  if not Add then
2063
    ClearGroup(GroupNumber);
2064
  for index := 0 to Group.count - 1 do
2065
    TSprite(Group[index]).GroupNumber := GroupNumber;
2066
end; {CurrentToGroup}
2067
 
2068
procedure TSpriteEngine.GroupToCurrent(GroupNumber: Integer; Add: Boolean = False);
2069
var
2070
  Group: Tlist;
2071
  index: Integer;
2072
begin
2073
  if not Add then
2074
    ClearCurrent;
2075
  Group := Groups[GroupNumber];
2076
  if Group <> nil then
2077
    for index := 0 to Group.count - 1 do
2078
      TSprite(Group[index]).Selected := true;
2079
end; {GroupToCurrent}
2080
 
2081
function TSpriteEngine.GetGroup(Index: Integer): Tlist;
2082
begin
2083
  if (index >= 0) or (index < fGroupCount) then
2084
    Result := fGroups[index]
2085
  else
2086
    Result := nil;
2087
end; {GetGroup}
2088
 
2089
procedure TSpriteEngine.SetGroupCount(AGroupCount: Integer);
2090
var
2091
  index: Integer;
2092
begin
2093
  if (AGroupCount <> FGroupCount) and (AGroupCount >= 0) then
2094
  begin
2095
    if FGroupCount > AGroupCount then
2096
    begin // remove groups
2097
      for index := AGroupCount to FGroupCount - 1 do
2098
      begin
2099
        ClearGroup(index);
2100
        FGroups[index].Free;
2101
      end;
2102
      SetLength(FGroups, AGroupCount);
2103
    end
2104
    else
2105
    begin // add groups
2106
      SetLength(FGroups, AGroupCount);
2107
      for index := FGroupCount to AGroupCount - 1 do
2108
        FGroups[index] := Tlist.Create;
2109
    end;
2110
    FGroupCount := Length(FGroups);
2111
  end;
2112
end; {SetGroupCount}
2113
{$ENDIF}
2114
 
1 daniel-mar 2115
procedure TSpriteEngine.Dead;
2116
begin
4 daniel-mar 2117
  while FDeadList.Count > 0 do
2118
    TSprite(FDeadList[FDeadList.Count - 1]).Free;
1 daniel-mar 2119
end;
2120
 
2121
procedure TSpriteEngine.Draw;
2122
begin
2123
  FDrawCount := 0;
2124
  inherited Draw;
2125
end;
2126
 
2127
procedure TSpriteEngine.SetSurface(Value: TDirectDrawSurface);
2128
begin
2129
  FSurface := Value;
4 daniel-mar 2130
  if FSurface <> nil then
1 daniel-mar 2131
  begin
2132
    FSurfaceRect := Surface.ClientRect;
4 daniel-mar 2133
    Width := FSurfaceRect.Right - FSurfaceRect.Left;
2134
    Height := FSurfaceRect.Bottom - FSurfaceRect.Top;
1 daniel-mar 2135
  end;
2136
end;
2137
 
2138
{  TCustomDXSpriteEngine  }
2139
 
4 daniel-mar 2140
constructor TCustomDXSpriteEngine.Create(AOwner: TComponent);
1 daniel-mar 2141
begin
4 daniel-mar 2142
  inherited Create(AOwner);
1 daniel-mar 2143
  FEngine := TSpriteEngine.Create(nil);
4 daniel-mar 2144
  FEngine.FOwner := Self;
2145
  FItems := TSpriteCollection.Create(Self);
2146
  FItems.FOwner := Self;
2147
  FItems.FOwnerItem := FEngine;
2148
  FItems.Initialize(FEngine);
1 daniel-mar 2149
end;
2150
 
2151
destructor TCustomDXSpriteEngine.Destroy;
4 daniel-mar 2152
begin
1 daniel-mar 2153
  FEngine.Free;
2154
  inherited Destroy;
2155
end;
2156
 
2157
procedure TCustomDXSpriteEngine.Notification(AComponent: TComponent;
2158
  Operation: TOperation);
2159
begin
2160
  inherited Notification(AComponent, Operation);
4 daniel-mar 2161
  if (Operation = opRemove) and (DXDraw = AComponent) then
1 daniel-mar 2162
    DXDraw := nil;
2163
end;
2164
 
2165
procedure TCustomDXSpriteEngine.Dead;
2166
begin
2167
  FEngine.Dead;
2168
end;
2169
 
2170
procedure TCustomDXSpriteEngine.Draw;
2171
begin
4 daniel-mar 2172
  if (FDXDraw <> nil) and (FDXDraw.Initialized) then
2173
    FEngine.Draw;
1 daniel-mar 2174
end;
2175
 
2176
procedure TCustomDXSpriteEngine.Move(MoveCount: Integer);
2177
begin
2178
  FEngine.Move(MoveCount);
2179
end;
2180
 
2181
procedure TCustomDXSpriteEngine.DXDrawNotifyEvent(Sender: TCustomDXDraw;
2182
  NotifyType: TDXDrawNotifyType);
2183
begin
2184
  case NotifyType of
2185
    dxntDestroying: DXDraw := nil;
2186
    dxntInitialize: FEngine.Surface := Sender.Surface;
4 daniel-mar 2187
    dxntFinalize: FEngine.Surface := nil;
1 daniel-mar 2188
  end;
2189
end;
2190
 
2191
procedure TCustomDXSpriteEngine.SetDXDraw(Value: TCustomDXDraw);
2192
begin
4 daniel-mar 2193
  if FDXDraw <> nil then
1 daniel-mar 2194
    FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
2195
 
2196
  FDXDraw := Value;
2197
 
4 daniel-mar 2198
  if FDXDraw <> nil then
1 daniel-mar 2199
    FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
2200
end;
2201
 
4 daniel-mar 2202
procedure TCustomDXSpriteEngine.SetItems(const Value: TSpriteCollection);
2203
begin
2204
  FItems.Assign(Value);
2205
end;
2206
 
2207
procedure TCustomDXSpriteEngine.Clone(const Amount: Word; const BaseNameOfSprite: string);
2208
var
2209
  i: Integer;
2210
begin
2211
  if Amount = 0 then Exit;
2212
  for i := 1 to Amount do
2213
  begin
2214
    with FItems.Add do
2215
    begin
2216
      KindSprite := FItems.Find(BaseNameOfSprite).KindSprite;
2217
      Sprite.AsSign(FItems.Find(BaseNameOfSprite).Sprite);
2218
      {name has to be different}
2219
      Name := Format(BaseNameOfSprite + '_%d', [I]); //simple name for sprite like Name_1 etc.
2220
      Sprite.Tag := 0; //for sprite you can use Tag property in future as well
2221
    end;
2222
  end;
2223
end;
2224
 
2225
function TCustomDXSpriteEngine.ForEach(PrefixNameOdSprite: string; var Names: TStringList): Boolean;
2226
var
2227
  I: Integer;
2228
begin
2229
  if Names = nil then
2230
    Names := TStringList.Create;
2231
  for I := 0 to Items.Count - 1 do
2232
  begin
2233
    if PrefixNameOdSprite = '' then
2234
      Names.Add(Items[I].Name)
2235
    else
2236
      {is prefix, fo names like Player????}
2237
      if Pos(PrefixNameOdSprite, Items[I].Name) = 1 then
2238
        Names.Add(Items[I].Name);
2239
  end;
2240
  Result := Names.Count > 0;
2241
  if not Result then {$IFDEF VER5UP}FreeAndNil(Names){$ELSE}begin Names.Free; names := nil end{$ENDIF};
2242
end;
2243
 
2244
{ TSpriteCollectionItem }
2245
 
2246
function TSpriteCollectionItem.GetSpriteCollection: TSpriteCollection;
2247
begin
2248
  Result := Collection as TSpriteCollection;
2249
end;
2250
 
2251
procedure TSpriteCollectionItem.SetSprite(const Value: TSprite);
2252
begin
2253
  FSprite.Assign(Value);
2254
end;
2255
 
2256
constructor TSpriteCollectionItem.Create(Collection: TCollection);
2257
begin
2258
  inherited Create(Collection);
2259
  FOwner := Collection;
2260
  FOwnerItem := (Collection as TSpriteCollection).FOwnerItem;
2261
  FSpriteType := stSprite;
2262
  FSprite := TSprite.Create(FOwnerItem);
2263
end;
2264
 
2265
procedure TSpriteCollectionItem.Assign(Source: TPersistent);
2266
begin
2267
  if Source is TSpriteCollectionItem then
2268
  begin
2269
    Finalize;
2270
    FSprite.Assign(TSpriteCollectionItem(Source).FSprite);
2271
    inherited Assign(Source);
2272
    Initialize;
2273
  end
2274
  else
2275
    inherited;
2276
end;
2277
 
2278
procedure TSpriteCollectionItem.Initialize;
2279
begin
2280
 
2281
end;
2282
 
2283
destructor TSpriteCollectionItem.Destroy;
2284
begin
2285
  FSprite.Destroy;
2286
  inherited;
2287
end;
2288
 
2289
procedure TSpriteCollectionItem.Finalize;
2290
begin
2291
 
2292
end;
2293
 
2294
procedure TSpriteCollectionItem.SetOnCollision(
2295
  const Value: TCollisionEvent);
2296
begin
2297
  FSprite.FOnCollision := Value;
2298
end;
2299
 
2300
procedure TSpriteCollectionItem.SetOnDraw(const Value: TDrawEvent);
2301
begin
2302
  FSprite.FOnDraw := Value;
2303
end;
2304
 
2305
procedure TSpriteCollectionItem.SetOnMove(const Value: TMoveEvent);
2306
begin
2307
  FSprite.FOnMove := Value
2308
end;
2309
 
2310
function TSpriteCollectionItem.GetDisplayName: string;
2311
begin
2312
  Result := inherited GetDisplayName
2313
end;
2314
 
2315
procedure TSpriteCollectionItem.SetDisplayName(const Value: string);
2316
begin
2317
  if (Value <> '') and (AnsiCompareText(Value, GetDisplayName) <> 0) and
2318
    (Collection is TSpriteCollection) and (TSpriteCollection(Collection).IndexOf(Value) >= 0) then
2319
    raise Exception.Create(Format(SSpriteDuplicateName, [Value]));
2320
  inherited SetDisplayName(Value);
2321
end;
2322
 
2323
function TSpriteCollectionItem.GetSpriteType: TSpriteType;
2324
begin
2325
  Result := FSpriteType;
2326
end;
2327
 
2328
procedure TSpriteCollectionItem.SetSpriteType(const Value: TSpriteType);
2329
var
2330
  tmpSprite: TSprite;
2331
begin
2332
  if Value <> FSpriteType then
2333
  begin
2334
    case Value of
2335
      stSprite: tmpSprite := TSprite.Create(TSpriteEngine(FOwnerItem));
2336
      stImageSprite: TImageSprite(tmpSprite) := TImageSprite.Create(TSpriteEngine(FOwnerItem));
6 daniel-mar 2337
      {$WARN SYMBOL_DEPRECATED OFF} // Added by ViaThinkSoft [2015-12-07]
4 daniel-mar 2338
      stImageSpriteEx: TImageSpriteEx(tmpSprite) := TImageSpriteEx.Create(TSpriteEngine(FOwnerItem));
6 daniel-mar 2339
      {$WARN SYMBOL_DEPRECATED ON} // Added by ViaThinkSoft [2015-12-07]
4 daniel-mar 2340
      stBackgroundSprite: TBackgroundSprite(tmpSprite) := TBackgroundSprite.Create(TSpriteEngine(FOwnerItem));
2341
    else
2342
      tmpSprite := nil
2343
    end;
2344
    if Assigned(FSprite) then
2345
    try
2346
      tmpSprite.Assign(FSprite);
2347
      tmpSprite.FOnDraw := FSprite.FOnDraw;
2348
      tmpSprite.FOnMove := FSprite.FOnMove;
2349
      tmpSprite.FOnCollision := FSprite.FOnCollision;
2350
      tmpSprite.FOnGetImage := FSprite.FOnGetImage;
2351
    finally
2352
      FSprite.Free; FSprite := nil;
2353
    end;
2354
    FSprite := tmpSprite;
2355
    FSpriteType := Value;
2356
  end;
2357
end;
2358
 
2359
function TSpriteCollectionItem.GetOnCollision: TCollisionEvent;
2360
begin
2361
  Result := FSprite.FOnCollision
2362
end;
2363
 
2364
function TSpriteCollectionItem.GetOnDraw: TDrawEvent;
2365
begin
2366
  Result := FSprite.FOnDraw
2367
end;
2368
 
2369
function TSpriteCollectionItem.GetOnMove: TMoveEvent;
2370
begin
2371
  Result := FSprite.FOnMove
2372
end;
2373
 
2374
function TSpriteCollectionItem.GetOnGetImage: TGetImage;
2375
begin
2376
  Result := FSprite.FOnGetImage;
2377
end;
2378
 
2379
procedure TSpriteCollectionItem.SetOnGetImage(const Value: TGetImage);
2380
begin
2381
  FSprite.FOnGetImage := Value;
2382
end;
2383
 
2384
function TSpriteCollectionItem.GetImageList: TCustomDXImageList;
2385
begin
2386
  Result := FSprite.FDXImageList;
2387
end;
2388
 
2389
procedure TSpriteCollectionItem.SetImageList(const Value: TCustomDXImageList);
2390
begin
2391
  FSprite.FDXImageList := Value;
2392
end;
2393
 
2394
function TSpriteCollectionItem.Clone(NewName: string): TSprite;
2395
var
2396
  T: TSpriteCollectionItem;
2397
begin
2398
  T := GetSpriteCollection.Add;
2399
  T.KindSprite := Self.FSpriteType;
2400
  T.Assign(Self);
2401
  T.Name := NewName;
2402
  Result := T.FSprite;
2403
end;
2404
 
2405
{ TSpriteCollection }
2406
 
2407
function TSpriteCollection.Initialized: Boolean;
2408
begin
2409
  Result := FInitializeFlag;
2410
end;
2411
 
2412
constructor TSpriteCollection.Create(AOwner: TPersistent);
2413
begin
2414
  inherited Create(TSpriteCollectionItem);
2415
  FOwner := AOwner;
2416
  FInitializeFlag := Initialize(TSpriteEngine(AOwner));
2417
end;
2418
 
2419
function TSpriteCollection.GetItem(Index: Integer): TSpriteCollectionItem;
2420
begin
2421
  Result := TSpriteCollectionItem(inherited Items[Index]);
2422
end;
2423
 
2424
function TSpriteCollection.Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
2425
begin
2426
  Result := True;
2427
  try
2428
    if AsSigned(FOnInitialize) then
2429
      FOnInitialize(DXSpriteEngine);
2430
  except
2431
    Result := False;
2432
  end
2433
end;
2434
 
2435
function TSpriteCollection.Find(const Name: string): TSpriteCollectionItem;
2436
var
2437
  i: Integer;
2438
begin
2439
  i := IndexOf(Name);
2440
  if i = -1 then
2441
    raise ESpriteCollectionError.CreateFmt(SSpriteNotFound, [Name]);
2442
  Result := Items[i];
2443
end;
2444
 
2445
procedure TSpriteCollection.Finalize;
2446
begin
2447
  if AsSigned(FOnFinalize) then
2448
    FOnFinalize(FOwnerItem);
2449
end;
2450
 
2451
function TSpriteCollection.GetOwner: TPersistent;
2452
begin
2453
  Result := FOwner;
2454
end;
2455
 
2456
function TSpriteCollection.Add: TSpriteCollectionItem;
2457
begin
2458
  Result := TSpriteCollectionItem(inherited Add);
2459
  Result.FOwner := FOwner;
2460
  Result.FOwnerItem := FOwnerItem;
2461
end;
2462
 
2463
destructor TSpriteCollection.Destroy;
2464
begin
2465
  Finalize;
2466
  inherited;
2467
end;
2468
 
1 daniel-mar 2469
end.