Subversion Repositories spacemission

Rev

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

  1. unit DXSprite;
  2.  
  3. interface
  4.  
  5. {$INCLUDE DelphiXcfg.inc}
  6.  
  7. uses
  8.   Windows, SysUtils, Classes, Graphics, DXClass, DXDraws,
  9.   {$IFDEF VER9UP} Types,{$ENDIF}
  10. {$IFDEF StandardDX}
  11.   DirectDraw;
  12. {$ELSE}
  13.   DirectX;
  14. {$ENDIF}
  15.  
  16. type
  17.  
  18.   {  ESpriteError  }
  19.  
  20.   ESpriteError = class(Exception);
  21.  
  22.   {  TSprite  }
  23.  
  24.   TSpriteEngine = class;
  25.  
  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)
  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;
  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;
  62.     procedure Add(Sprite: TSprite);
  63.     procedure Remove(Sprite: TSprite);
  64.     procedure AddDrawList(Sprite: TSprite);
  65.     procedure Collision2;
  66.     procedure Draw; {$IFDEF VER9UP}inline;{$ENDIF}
  67.     function GetClientRect: TRect;
  68.     function GetCount: Integer;
  69.     function GetItem(Index: Integer): TSprite;
  70.     function GetWorldX: Double; {$IFDEF VER9UP}inline;{$ENDIF}
  71.     function GetWorldY: Double; {$IFDEF VER9UP}inline;{$ENDIF}
  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;
  79.     {$IFDEF Ver4Up}
  80.     procedure SetGroupNumber(AGroupNumber: Integer); virtual;
  81.     procedure SetSelected(ASelected: Boolean); virtual;
  82.     {$ENDIF}
  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);
  90.     procedure ReAnimate(MoveCount: Integer); virtual;
  91.     function GetSpriteAt(X, Y: Integer): TSprite;
  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;
  97.     property Deaded: Boolean read FDeaded;
  98.     property Parent: TSprite read FParent;
  99.     property WorldX: Double read GetWorldX;
  100.     property WorldY: Double read GetWorldY;
  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
  108.     property Height: Integer read FHeight write FHeight;
  109.     property Moved: Boolean read FMoved write FMoved;
  110.     property Visible: Boolean read FVisible write FVisible;
  111.     property Width: Integer read FWidth write FWidth;
  112.     property X: Double read FX write FX;
  113.     property Y: Double read FY write FY;
  114.     property Z: Integer read FZ write SetZ;
  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;
  126.   end;
  127.  
  128.   TSpriteClass = class of TSprite;
  129.  
  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;
  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;
  151.     function GetDrawImageIndex: Integer;
  152.     function GetDrawRect: TRect;
  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);
  165.   protected
  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;
  198.     procedure DoDraw; override;
  199.     procedure DoMove(MoveCount: Integer); override;
  200.     function GetBoundsRect: TRect; override;
  201.     function TestCollision(Sprite: TSprite): Boolean; override;
  202.     procedure SetImage(AImage: TPictureCollectionItem); virtual;
  203.   public
  204.     constructor Create(AParent: TSprite); override;
  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;
  217.     property AnimPos: Double read FAnimPos write FAnimPos;
  218.     property AnimSpeed: Double read FAnimSpeed write FAnimSpeed;
  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;
  233.   end;
  234.  
  235.   {  TImageSpriteEx  }
  236.  
  237.   TImageSpriteEx = class(TImageSprite)
  238.   end{$IFDEF VER9UP}deprecated{$IFDEF VER14UP} 'Use for backward compatibility only or replace by TImageSprite instead...'{$ENDIF}{$ENDIF};
  239.  
  240.   {  TBackgroundSprite  }
  241.  
  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)
  262.   private
  263.     FMap: Pointer;
  264.     FMapWidth: Integer;
  265.     FMapHeight: Integer;
  266.  
  267.     FChipsRect: TRect;
  268.     FChipsPatternIndex: Integer;
  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);
  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);
  284.   protected
  285.     procedure ReadMapData(Stream: TStream);
  286.     procedure WriteMapData(Stream: TStream);
  287.     procedure DoDraw; override;
  288.     function GetBoundsRect: TRect; override;
  289.     function TestCollision(Sprite: TSprite): Boolean; override;
  290.     procedure SetImage(Img: TPictureCollectionItem); override;
  291.     procedure DefineProperties(Filer: TFiler); override;
  292.   public
  293.     constructor Create(AParent: TSprite); override;
  294.     destructor Destroy; override;
  295.     procedure ChipsDraw(Image: TPictureCollectionItem; X, Y, PatternIndex: Integer);
  296.     procedure SetMapSize(AMapWidth, AMapHeight: Integer);
  297.     function IsMapEmpty: Boolean;
  298.     property Chips[X, Y: Integer]: Integer read GetChip write SetChip;
  299.     property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem;
  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}
  308.     property MapHeight: Integer read FMapHeight write SetMapHeight;
  309.     property MapWidth: Integer read FMapWidth write SetMapWidth;
  310.   published
  311.     property DXImageList;
  312.     property DXImageName;
  313.  
  314.     property OnDraw;
  315.     property OnMove;
  316.     property OnCollision;
  317.     property OnGetImage;
  318.   end;
  319.  
  320.   {  forward class  }
  321.  
  322.   TCustomDXSpriteEngine = class;
  323.  
  324.   {  TSpriteEngine  }
  325.  
  326.   TSpriteEngine = class(TSprite)
  327.   private
  328.     FOwner: TCustomDXSpriteEngine;
  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;
  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}
  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;
  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}
  379.   end;
  380.  
  381.   {  EDXSpriteEngineError  }
  382.  
  383.   EDXSpriteEngineError = class(Exception);
  384.  
  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.  
  469.   {  TCustomDXSpriteEngine  }
  470.  
  471.   TCustomDXSpriteEngine = class(TComponent)
  472.   private
  473.     FDXDraw: TCustomDXDraw;
  474.     FEngine: TSpriteEngine;
  475.     FItems: TSpriteCollection;
  476.     procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
  477.     procedure SetDXDraw(Value: TCustomDXDraw);
  478.     procedure SetItems(const Value: TSpriteCollection);
  479.   protected
  480.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  481.   public
  482.     constructor Create(AOwner: TComponent); override;
  483.     destructor Destroy; override;
  484.     procedure Dead;
  485.     procedure Draw;
  486.     procedure Move(MoveCount: Integer);
  487.     procedure Clone(const Amount: Word; const BaseNameOfSprite: string);
  488.     function ForEach(PrefixNameOdSprite: string; var Names: TStringList): Boolean;
  489.     property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
  490.     property Engine: TSpriteEngine read FEngine;
  491.     property Items: TSpriteCollection read FItems write SetItems;
  492.   end;
  493.  
  494.   {  TDXSpriteEngine  }
  495.  
  496.   TDXSpriteEngine = class(TCustomDXSpriteEngine)
  497.     property Items;
  498.   published
  499.     property DXDraw;
  500.   end;
  501.  
  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.  
  506. implementation
  507.  
  508. uses DXConsts, TypInfo;
  509.  
  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.  
  536. function Mod2(i, i2: Integer): Integer;
  537. begin
  538.   Result := i mod i2;
  539.   if Result < 0 then
  540.     Result := i2 + Result;
  541. end;
  542.  
  543. function Mod2f(i: Double; i2: Integer): Double;
  544. begin
  545.   if i2 = 0 then
  546.     Result := i
  547.   else
  548.   begin
  549.     Result := i - Round(i / i2) * i2;
  550.     if Result < 0 then
  551.       Result := i2 + Result;
  552.   end;
  553. end;
  554.  
  555. {  TSprite  }
  556.  
  557. constructor TSprite.Create(AParent: TSprite);
  558. begin
  559.   inherited Create;
  560. {$IFDEF Ver4Up}
  561.   fGroupnumber := -1;
  562. {$ENDIF}
  563.   FParent := AParent;
  564.   if FParent <> nil then
  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
  581. {$IFDEF Ver4Up}
  582.   GroupNumber := -1;
  583.   Selected := False;
  584. {$ENDIF}
  585.   Clear;
  586.   if FParent <> nil then
  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.  
  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.  
  624. procedure TSprite.Add(Sprite: TSprite);
  625. begin
  626.   if FList = nil then
  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);
  639.   if FList.Count = 0 then
  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;
  657.     C := TSprite(FDrawList[I]).Z - Sprite.Z;
  658.     if C < 0 then
  659.       L := I + 1
  660.     else
  661.       H := I - 1;
  662.   end;
  663.   FDrawList.Insert(L, Sprite);
  664. end;
  665.  
  666. procedure TSprite.Clear;
  667. begin
  668.   while Count > 0 do
  669.     Items[Count - 1].Free;
  670. end;
  671.  
  672. function TSprite.Collision: Integer;
  673. var
  674.   i: Integer;
  675. begin
  676.   Result := 0;
  677.   if (FEngine <> nil) and (not FDeaded) and (Collisioned) then
  678.   begin
  679.     with FEngine do
  680.     begin
  681.       FCollisionCount := 0;
  682.       FCollisionDone := False;
  683.       FCollisionRect := Self.BoundsRect;
  684.       FCollisionSprite := Self;
  685.  
  686.       for i := 0 to Count - 1 do
  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
  700.     if (Self <> FEngine.FCollisionSprite) and OverlapRect(BoundsRect,
  701.       FEngine.FCollisionRect) and FEngine.FCollisionSprite.TestCollision(Self) and
  702.       TestCollision(FEngine.FCollisionSprite) then
  703.     begin
  704.       Inc(FEngine.FCollisionCount);
  705.       FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone);
  706.       if (not FEngine.FCollisionSprite.Collisioned) or
  707.         (FEngine.FCollisionSprite.FDeaded) then
  708.       begin
  709.         FEngine.FCollisionDone := True;
  710.       end;
  711.     end;
  712.     if FEngine.FCollisionDone then
  713.       Exit;
  714.     for i := 0 to Count - 1 do
  715.       Items[i].Collision2;
  716.   end;
  717. end;
  718.  
  719. procedure TSprite.Dead;
  720. begin
  721.   if (FEngine <> nil) and (not FDeaded) then
  722.   begin
  723.     FDeaded := True;
  724.     FEngine.FDeadList.Add(Self);
  725.   end;
  726. end;
  727.  
  728. procedure TSprite.DoMove(MoveCount: Integer);
  729. begin
  730.   if AsSigned(FOnMove) then
  731.     FOnMove(Self, MoveCount);
  732. end;
  733.  
  734. procedure TSprite.DoDraw;
  735. begin
  736.   if AsSigned(FOnDraw) then
  737.     FOnDraw(Self);
  738. end;
  739.  
  740. procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
  741. begin
  742.   if AsSigned(FOnCollision) then
  743.     FOnCollision(Sprite, Done);
  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
  757.     DoMove(MoveCount); ReAnimate(MoveCount);
  758.     for i := 0 to Count - 1 do
  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
  769.     if FEngine <> nil then
  770.     begin
  771.       if OverlapRect(FEngine.FSurfaceRect, BoundsRect) then
  772.       begin
  773.         DoDraw;
  774.         Inc(FEngine.FDrawCount);
  775.       end;
  776.     end;
  777.  
  778.     if FDrawList <> nil then
  779.     begin
  780.       for i := 0 to FDrawList.Count - 1 do
  781.       begin
  782.         TSprite(FDrawList[i]).Draw;
  783.       end;
  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
  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
  797.     begin
  798.       if (Result = nil) or (Sprite.Z > Result.Z) then
  799.         Result := Sprite;
  800.     end;
  801.  
  802.     X2 := X - Sprite.X;
  803.     Y2 := Y - Sprite.Y;
  804.     for i := 0 to Sprite.Count - 1 do
  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.  
  814.   X2 := X - Self.X;
  815.   Y2 := Y - Self.Y;
  816.   for i := 0 to Count - 1 do
  817.     Collision_GetSpriteAt(X2, Y2, Items[i]);
  818. end;
  819.  
  820. function TSprite.GetBoundsRect: TRect;
  821. begin
  822.   Result := Bounds(Round(WorldX), Round(WorldY), Width, Height);
  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
  832.   if FList <> nil then
  833.     Result := FList.Count
  834.   else
  835.     Result := 0;
  836. end;
  837.  
  838. function TSprite.GetItem(Index: Integer): TSprite;
  839. begin
  840.   if FList <> nil then
  841.     Result := FList[Index]
  842.   else
  843.     raise ESpriteError.CreateFmt(SListIndexError, [Index]);
  844. end;
  845.  
  846. function TSprite.GetWorldX: Double;
  847. begin
  848.   if Parent <> nil then
  849.     Result := Parent.WorldX + FX
  850.   else
  851.     Result := FX;
  852. end;
  853.  
  854. function TSprite.GetWorldY: Double;
  855. begin
  856.   if Parent <> nil then
  857.     Result := Parent.WorldY + FY
  858.   else
  859.     Result := FY;
  860. end;
  861.  
  862. procedure TSprite.SetZ(Value: Integer);
  863. begin
  864.   if FZ <> Value then
  865.   begin
  866.     FZ := Value;
  867.     if Parent <> nil then
  868.     begin
  869.       Parent.FDrawList.Remove(Self);
  870.       Parent.AddDrawList(Self);
  871.     end;
  872.   end;
  873. end;
  874.  
  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.  
  910. {  TImageSprite  }
  911.  
  912. constructor TImageSprite.Create(AParent: TSprite);
  913. begin
  914.   inherited Create(AParent);
  915.   FTransparent := True;
  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;
  924. end;
  925.  
  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.  
  943. function TImageSprite.GetBoundsRect: TRect;
  944. var
  945.   dx, dy: Integer;
  946. begin
  947.   dx := Round(WorldX);
  948.   dy := Round(WorldY);
  949.   if FTile then
  950.   begin
  951.     dx := Mod2(dx, FEngine.SurfaceRect.Right + Width);
  952.     dy := Mod2(dy, FEngine.SurfaceRect.Bottom + Height);
  953.  
  954.     if dx > FEngine.SurfaceRect.Right then
  955.       dx := (dx - FEngine.SurfaceRect.Right) - Width;
  956.  
  957.     if dy > FEngine.SurfaceRect.Bottom then
  958.       dy := (dy - FEngine.SurfaceRect.Bottom) - Height;
  959.   end;
  960.  
  961.   Result := Bounds(dx, dy, Width, Height);
  962. end;
  963.  
  964. procedure TImageSprite.DoMove(MoveCount: Integer);
  965. begin
  966.   if AsSigned(FOnMove) then
  967.     FOnMove(Self, MoveCount)
  968.   else
  969.   begin
  970.     ReAnimate(MoveCount);
  971.   end;
  972. end;
  973.  
  974. function TImageSprite.GetDrawImageIndex: Integer;
  975. begin
  976.   Result := FAnimStart + Trunc(FAnimPos); //solve 1.07f to Round()
  977. end;
  978.  
  979. function TImageSprite.GetDrawRect: TRect;
  980. begin
  981.   Result := BoundsRect;
  982.   OffsetRect(Result, (Width - Image.Width) div 2, (Height - Image.Height) div 2);
  983. end;
  984.  
  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.  
  1005. procedure TImageSprite.DoDraw;
  1006. var
  1007.   r: TRect;
  1008. begin
  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;
  1023. end;
  1024.  
  1025. {$WARNINGS OFF}
  1026. {$HINTS OFF}
  1027.  
  1028. function TImageSprite.ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
  1029.   const rect1, rect2: TRect; x1, y1, x2, y2: Integer; DoPixelCheck: Boolean): Boolean;
  1030.  
  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;
  1046.  
  1047.   TRGB = packed record
  1048.     R, G, B: byte;
  1049.   end;
  1050. var
  1051.   ddsd1, ddsd2: {$IFDEF D3D_deprecated}TDDSURFACEDESC{$ELSE}TDDSurfaceDesc2{$ENDIF};
  1052.   r1, r2, r1a, r2a: TRect;
  1053.   tc1, tc2: DWORD;
  1054.   x, y, w, h: Integer;
  1055.   P1, P2: Pointer;
  1056. begin
  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;
  1063.  
  1064.   with rect2 do
  1065.     r2 := Bounds(x2 - x1, y2 - y1, Right - Left, Bottom - Top);
  1066.  
  1067.   Result := OverlapRect(r1, r2);
  1068.  
  1069.   if (suf1 = nil) or (suf2 = nil) then
  1070.     Exit;
  1071.  
  1072.   if DoPixelCheck and Result then
  1073.   begin
  1074.     {  Get Overlapping rectangle  }
  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);
  1079.  
  1080.     ClipRect(r1, r1a);
  1081.     ClipRect(r2, r2a);
  1082.  
  1083.     w := Min(r1.Right - r1.Left, r2.Right - r2.Left);
  1084.     h := Min(r1.Bottom - r1.Top, r2.Bottom - r2.Top);
  1085.  
  1086.     ClipRect(r1, bounds(r1.Left, r1.Top, w, h));
  1087.     ClipRect(r2, bounds(r2.Left, r2.Top, w, h));
  1088.  
  1089.     {  Pixel check !!!  }
  1090.     ddsd1.dwSize := SizeOf(ddsd1);
  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.  
  1103.     if suf1.Lock(r1, ddsd1) then
  1104.     begin
  1105.       try
  1106.         ddsd2.dwSize := SizeOf(ddsd2);
  1107.         if (suf1 = suf2) or suf2.Lock(r2, ddsd2) then
  1108.         begin
  1109.           try
  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.  
  1115.             {  Get transparent color  }
  1116.             tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
  1117.             tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;
  1118.  
  1119.             case ddsd1.ddpfPixelFormat.dwRGBBitCount of
  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
  1127.                     begin
  1128.                       if (PByte(P1)^ <> tc1) and (PByte(P2)^ <> tc2) then
  1129.                         Exit;
  1130.                       Inc(PByte(P1));
  1131.                       Inc(PByte(P2));
  1132.                     end;
  1133.                   end;
  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
  1142.                     begin
  1143.                       if (PWord(P1)^ <> tc1) and (PWord(P2)^ <> tc2) then
  1144.                         Exit;
  1145.                       Inc(PWord(P1));
  1146.                       Inc(PWord(P2));
  1147.                     end;
  1148.                   end;
  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
  1157.                     begin
  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));
  1166.                     end;
  1167.                   end;
  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
  1176.                     begin
  1177.                       if (PDWORD(P1)^ <> tc1) and (PDWORD(P2)^ <> tc2) then
  1178.                         Exit;
  1179.                       Inc(PDWORD(P1));
  1180.                       Inc(PDWORD(P2));
  1181.                     end;
  1182.                   end;
  1183.                 end;
  1184.             end;
  1185.           finally
  1186.             if suf1 <> suf2 then
  1187.               suf2.UnLock;
  1188.           end;
  1189.         end;
  1190.       finally
  1191.         suf1.UnLock;
  1192.       end;
  1193.     end;
  1194.  
  1195.     Result := False;
  1196.   end;
  1197. end;
  1198.  
  1199. {$HINTS ON}
  1200. {$WARNINGS ON}
  1201.  
  1202. function TImageSprite.TestCollision(Sprite: TSprite): Boolean;
  1203. var
  1204.   img1, img2: Integer;
  1205.   box1, box2: TRect;
  1206. begin
  1207.   if (Sprite is TImageSprite) then
  1208.     if FPixelCheck then
  1209.     begin
  1210.       box1 := GetDrawRect;
  1211.       box2 := TImageSprite(Sprite).GetDrawRect;
  1212.  
  1213.       img1 := GetDrawImageIndex;
  1214.       img2 := TImageSprite(Sprite).GetDrawImageIndex;
  1215.  
  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
  1225.     Result := inherited TestCollision(Sprite);
  1226. end;
  1227.  
  1228. procedure TImageSprite.Assign(Source: TPersistent);
  1229. begin
  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;
  1248. end;
  1249.  
  1250. procedure TImageSprite.ReAnimate(MoveCount: Integer);
  1251. var
  1252.   I: Integer;
  1253. begin
  1254.   FAnimPos := FAnimPos + FAnimSpeed * MoveCount;
  1255.  
  1256.   if FAnimLooped then
  1257.   begin
  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
  1266.     begin
  1267.       FAnimPos := FAnimCount - 1;
  1268.       FAnimSpeed := 0;
  1269.     end;
  1270.     if FAnimPos < 0 then
  1271.     begin
  1272.       FAnimPos := 0;
  1273.       FAnimSpeed := 0;
  1274.     end;
  1275.   end;
  1276.   if FBlurImage then
  1277.   begin
  1278.     {ale jen jsou-li jine souradnice}
  1279.     if (FBlurImageArr[High(FBlurImageArr)].eX <> Round(WorldX)) or
  1280.     (FBlurImageArr[High(FBlurImageArr)].eY <> Round(WorldY)) then
  1281.     begin
  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;
  1297.     end;
  1298.   end;
  1299. end;
  1300.  
  1301. function TImageSprite.StoreCenterX: Boolean;
  1302. begin
  1303.   Result := FCenterX <> 0.5;
  1304. end;
  1305.  
  1306. function TImageSprite.StoreCenterY: Boolean;
  1307. begin
  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
  1520.   begin
  1521.     FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0); //get out when set up
  1522.   end;
  1523.   FBlurImage := Value;
  1524. end;
  1525.  
  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.  
  1536. {  TBackgroundSprite  }
  1537.  
  1538. constructor TBackgroundSprite.Create(AParent: TSprite);
  1539. begin
  1540.   inherited Create(AParent);
  1541.   FMap := nil;
  1542.   FMapWidth := 0;
  1543.   FMapHeight := 0;
  1544.   Collisioned := False;
  1545. end;
  1546.  
  1547. destructor TBackgroundSprite.Destroy;
  1548. begin
  1549.   SetMapSize(0, 0);
  1550.   inherited Destroy;
  1551. end;
  1552.  
  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.  
  1569. procedure TBackgroundSprite.DoDraw;
  1570. var
  1571.   TmpX, TmpY, cx, cy, cx2, cy2, PatternIndex, ChipWidth, ChipHeight: Integer;
  1572.   StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer;
  1573.   r: TRect;
  1574.   Q: TMapType;
  1575. begin
  1576.   LoadImage;
  1577.   if Image = nil then
  1578.     Exit;
  1579.  
  1580.   if (FMapWidth <= 0) or (FMapHeight <= 0) then
  1581.     Exit;
  1582.  
  1583.   r := Image.PatternRects[0];
  1584.   ChipWidth := r.Right - r.Left;
  1585.   ChipHeight := r.Bottom - r.Top;
  1586.  
  1587.   dWidth := (FEngine.SurfaceRect.Right + ChipWidth) div ChipWidth + 1;
  1588.   dHeight := (FEngine.SurfaceRect.Bottom + ChipHeight) div ChipHeight + 1;
  1589.  
  1590.   TmpX := Round(WorldX);
  1591.   TmpY := Round(WorldY);
  1592.  
  1593.   OfsX := TmpX mod ChipWidth;
  1594.   OfsY := TmpY mod ChipHeight;
  1595.  
  1596.   StartX := TmpX div ChipWidth;
  1597.   StartX_ := 0;
  1598.  
  1599.   if StartX < 0 then
  1600.   begin
  1601.     StartX_ := -StartX;
  1602.     StartX := 0;
  1603.   end;
  1604.  
  1605.   StartY := TmpY div ChipHeight;
  1606.   StartY_ := 0;
  1607.  
  1608.   if StartY < 0 then
  1609.   begin
  1610.     StartY_ := -StartY;
  1611.     StartY := 0;
  1612.   end;
  1613.  
  1614.   EndX := Min(StartX + FMapWidth - StartX_, dWidth);
  1615.   EndY := Min(StartY + FMapHeight - StartY_, dHeight);
  1616.  
  1617.   if FTile then
  1618.   begin
  1619.     for cy := -1 to dHeight do
  1620.     begin
  1621.       cy2 := Mod2((cy - StartY + StartY_), FMapHeight);
  1622.       for cx := -1 to dWidth do
  1623.       begin
  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;
  1644.       end;
  1645.     end;
  1646.   end
  1647.   else
  1648.   begin
  1649.     for cy := StartY to EndY - 1 do
  1650.       for cx := StartX to EndX - 1 do
  1651.       begin
  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
  1671.       end;
  1672.   end;
  1673. end;
  1674.  
  1675. function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean;
  1676. var
  1677.   box0, box1, box2: TRect;
  1678.   cx, cy, ChipWidth, ChipHeight: Integer;
  1679.   r: TRect;
  1680. begin
  1681.   Result := True;
  1682.   if Image = nil then
  1683.     Exit;
  1684.   if (FMapWidth <= 0) or (FMapHeight <= 0) then
  1685.     Exit;
  1686.  
  1687.   r := Image.PatternRects[0];
  1688.   ChipWidth := r.Right - r.Left;
  1689.   ChipHeight := r.Bottom - r.Top;
  1690.  
  1691.   box1 := Sprite.BoundsRect;
  1692.   box2 := BoundsRect;
  1693.  
  1694.   IntersectRect(box0, box1, box2);
  1695.  
  1696.   OffsetRect(box0, -Round(WorldX), -Round(WorldY));
  1697.   OffsetRect(box1, -Round(WorldX), -Round(WorldY));
  1698.  
  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
  1701.       if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then
  1702.       begin
  1703.         if OverlapRect(Bounds(cx * ChipWidth, cy * ChipHeight, ChipWidth,
  1704.           ChipHeight), box1) then
  1705.           Exit;
  1706.       end;
  1707.  
  1708.   Result := False;
  1709. end;
  1710.  
  1711. function TBackgroundSprite.GetChip(X, Y: Integer): Integer;
  1712. begin
  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
  1715.   else
  1716.     Result := -1;
  1717. end;
  1718.  
  1719. function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean;
  1720. begin
  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
  1723.   else
  1724.     Result := False;
  1725. end;
  1726.  
  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.  
  1751. function TBackgroundSprite.GetBoundsRect: TRect;
  1752. begin
  1753.   if FTile then
  1754.     Result := FEngine.SurfaceRect
  1755.   else
  1756.   begin
  1757.     LoadImage;
  1758.     if Image <> nil then
  1759.       Result := Bounds(Round(WorldX), Round(WorldY), Image.Width * FMapWidth,
  1760.         Image.Height * FMapHeight)
  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
  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;
  1770. end;
  1771.  
  1772. procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean);
  1773. begin
  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;
  1776. end;
  1777.  
  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.  
  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.  
  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.  
  1821. procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer);
  1822. var I: Integer;
  1823. begin
  1824.   if (FMapWidth <> AMapWidth) or (FMapHeight <> AMapHeight) or (FMap = nil) then
  1825.   begin
  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;
  1845.     end;
  1846.   end
  1847. end;
  1848.  
  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;
  1856.   end;
  1857.   inherited;
  1858. end;
  1859.  
  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.  
  1916. {  TSpriteEngine  }
  1917.  
  1918. constructor TSpriteEngine.Create(AParent: TSprite);
  1919. begin
  1920.   inherited Create(AParent);
  1921.   FDeadList := TList.Create;
  1922.   // group handling
  1923. {$IFDEF Ver4Up}
  1924.   fCurrentSelected := Tlist.create;
  1925.   GroupCount := 10;
  1926. {$ENDIF}
  1927. end;
  1928.  
  1929. destructor TSpriteEngine.Destroy;
  1930. begin
  1931.   // cleanup Group handling
  1932. {$IFDEF Ver4Up}
  1933.   ClearCurrent;
  1934.   GroupCount := 0;
  1935. {$ENDIF}
  1936.   FDeadList.Free;
  1937.   inherited Destroy;
  1938. {$IFDEF Ver4Up}
  1939.   fCurrentSelected.free;
  1940. {$ENDIF}
  1941. end;
  1942.  
  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.  
  2115. procedure TSpriteEngine.Dead;
  2116. begin
  2117.   while FDeadList.Count > 0 do
  2118.     TSprite(FDeadList[FDeadList.Count - 1]).Free;
  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;
  2130.   if FSurface <> nil then
  2131.   begin
  2132.     FSurfaceRect := Surface.ClientRect;
  2133.     Width := FSurfaceRect.Right - FSurfaceRect.Left;
  2134.     Height := FSurfaceRect.Bottom - FSurfaceRect.Top;
  2135.   end;
  2136. end;
  2137.  
  2138. {  TCustomDXSpriteEngine  }
  2139.  
  2140. constructor TCustomDXSpriteEngine.Create(AOwner: TComponent);
  2141. begin
  2142.   inherited Create(AOwner);
  2143.   FEngine := TSpriteEngine.Create(nil);
  2144.   FEngine.FOwner := Self;
  2145.   FItems := TSpriteCollection.Create(Self);
  2146.   FItems.FOwner := Self;
  2147.   FItems.FOwnerItem := FEngine;
  2148.   FItems.Initialize(FEngine);
  2149. end;
  2150.  
  2151. destructor TCustomDXSpriteEngine.Destroy;
  2152. begin
  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);
  2161.   if (Operation = opRemove) and (DXDraw = AComponent) then
  2162.     DXDraw := nil;
  2163. end;
  2164.  
  2165. procedure TCustomDXSpriteEngine.Dead;
  2166. begin
  2167.   FEngine.Dead;
  2168. end;
  2169.  
  2170. procedure TCustomDXSpriteEngine.Draw;
  2171. begin
  2172.   if (FDXDraw <> nil) and (FDXDraw.Initialized) then
  2173.     FEngine.Draw;
  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;
  2187.     dxntFinalize: FEngine.Surface := nil;
  2188.   end;
  2189. end;
  2190.  
  2191. procedure TCustomDXSpriteEngine.SetDXDraw(Value: TCustomDXDraw);
  2192. begin
  2193.   if FDXDraw <> nil then
  2194.     FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
  2195.  
  2196.   FDXDraw := Value;
  2197.  
  2198.   if FDXDraw <> nil then
  2199.     FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
  2200. end;
  2201.  
  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));
  2337.       stImageSpriteEx: TImageSpriteEx(tmpSprite) := TImageSpriteEx.Create(TSpriteEngine(FOwnerItem));
  2338.       stBackgroundSprite: TBackgroundSprite(tmpSprite) := TBackgroundSprite.Create(TSpriteEngine(FOwnerItem));
  2339.     else
  2340.       tmpSprite := nil
  2341.     end;
  2342.     if Assigned(FSprite) then
  2343.     try
  2344.       tmpSprite.Assign(FSprite);
  2345.       tmpSprite.FOnDraw := FSprite.FOnDraw;
  2346.       tmpSprite.FOnMove := FSprite.FOnMove;
  2347.       tmpSprite.FOnCollision := FSprite.FOnCollision;
  2348.       tmpSprite.FOnGetImage := FSprite.FOnGetImage;
  2349.     finally
  2350.       FSprite.Free; FSprite := nil;
  2351.     end;
  2352.     FSprite := tmpSprite;
  2353.     FSpriteType := Value;
  2354.   end;
  2355. end;
  2356.  
  2357. function TSpriteCollectionItem.GetOnCollision: TCollisionEvent;
  2358. begin
  2359.   Result := FSprite.FOnCollision
  2360. end;
  2361.  
  2362. function TSpriteCollectionItem.GetOnDraw: TDrawEvent;
  2363. begin
  2364.   Result := FSprite.FOnDraw
  2365. end;
  2366.  
  2367. function TSpriteCollectionItem.GetOnMove: TMoveEvent;
  2368. begin
  2369.   Result := FSprite.FOnMove
  2370. end;
  2371.  
  2372. function TSpriteCollectionItem.GetOnGetImage: TGetImage;
  2373. begin
  2374.   Result := FSprite.FOnGetImage;
  2375. end;
  2376.  
  2377. procedure TSpriteCollectionItem.SetOnGetImage(const Value: TGetImage);
  2378. begin
  2379.   FSprite.FOnGetImage := Value;
  2380. end;
  2381.  
  2382. function TSpriteCollectionItem.GetImageList: TCustomDXImageList;
  2383. begin
  2384.   Result := FSprite.FDXImageList;
  2385. end;
  2386.  
  2387. procedure TSpriteCollectionItem.SetImageList(const Value: TCustomDXImageList);
  2388. begin
  2389.   FSprite.FDXImageList := Value;
  2390. end;
  2391.  
  2392. function TSpriteCollectionItem.Clone(NewName: string): TSprite;
  2393. var
  2394.   T: TSpriteCollectionItem;
  2395. begin
  2396.   T := GetSpriteCollection.Add;
  2397.   T.KindSprite := Self.FSpriteType;
  2398.   T.Assign(Self);
  2399.   T.Name := NewName;
  2400.   Result := T.FSprite;
  2401. end;
  2402.  
  2403. { TSpriteCollection }
  2404.  
  2405. function TSpriteCollection.Initialized: Boolean;
  2406. begin
  2407.   Result := FInitializeFlag;
  2408. end;
  2409.  
  2410. constructor TSpriteCollection.Create(AOwner: TPersistent);
  2411. begin
  2412.   inherited Create(TSpriteCollectionItem);
  2413.   FOwner := AOwner;
  2414.   FInitializeFlag := Initialize(TSpriteEngine(AOwner));
  2415. end;
  2416.  
  2417. function TSpriteCollection.GetItem(Index: Integer): TSpriteCollectionItem;
  2418. begin
  2419.   Result := TSpriteCollectionItem(inherited Items[Index]);
  2420. end;
  2421.  
  2422. function TSpriteCollection.Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
  2423. begin
  2424.   Result := True;
  2425.   try
  2426.     if AsSigned(FOnInitialize) then
  2427.       FOnInitialize(DXSpriteEngine);
  2428.   except
  2429.     Result := False;
  2430.   end
  2431. end;
  2432.  
  2433. function TSpriteCollection.Find(const Name: string): TSpriteCollectionItem;
  2434. var
  2435.   i: Integer;
  2436. begin
  2437.   i := IndexOf(Name);
  2438.   if i = -1 then
  2439.     raise ESpriteCollectionError.CreateFmt(SSpriteNotFound, [Name]);
  2440.   Result := Items[i];
  2441. end;
  2442.  
  2443. procedure TSpriteCollection.Finalize;
  2444. begin
  2445.   if AsSigned(FOnFinalize) then
  2446.     FOnFinalize(FOwnerItem);
  2447. end;
  2448.  
  2449. function TSpriteCollection.GetOwner: TPersistent;
  2450. begin
  2451.   Result := FOwner;
  2452. end;
  2453.  
  2454. function TSpriteCollection.Add: TSpriteCollectionItem;
  2455. begin
  2456.   Result := TSpriteCollectionItem(inherited Add);
  2457.   Result.FOwner := FOwner;
  2458.   Result.FOwnerItem := FOwnerItem;
  2459. end;
  2460.  
  2461. destructor TSpriteCollection.Destroy;
  2462. begin
  2463.   Finalize;
  2464.   inherited;
  2465. end;
  2466.  
  2467. end.
  2468.