WebSVN – spacemission – Blame – /VCL_DELPHIX_D6/DXSprite.pas

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.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXSprite.pas @ 1 – Rev 6