Rev 1 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 1 | Rev 4 | ||
|---|---|---|---|
| Line 3... | Line 3... | ||
| 3 | interface |
3 | interface |
| 4 | 4 | ||
| 5 | {$INCLUDE DelphiXcfg.inc} |
5 | {$INCLUDE DelphiXcfg.inc} |
| 6 | 6 | ||
| 7 | uses |
7 | uses |
| 8 | Windows, SysUtils, Classes, DXClass, DXDraws, DirectX; |
8 | Windows, SysUtils, Classes, Graphics, DXClass, DXDraws, |
| - | 9 | {$IFDEF VER9UP} Types,{$ENDIF} |
|
| - | 10 | {$IFDEF StandardDX} |
|
| - | 11 | DirectDraw; |
|
| - | 12 | {$ELSE} |
|
| - | 13 | DirectX; |
|
| - | 14 | {$ENDIF} |
|
| 9 | 15 | ||
| 10 | type |
16 | type |
| 11 | 17 | ||
| 12 | { ESpriteError } |
18 | { ESpriteError } |
| 13 | 19 | ||
| Line 15... | Line 21... | ||
| 15 | 21 | ||
| 16 | { TSprite } |
22 | { TSprite } |
| 17 | 23 | ||
| 18 | TSpriteEngine = class; |
24 | TSpriteEngine = class; |
| 19 | 25 | ||
| 20 | TSprite = class |
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) |
|
| 21 | private |
33 | private |
| 22 | FEngine: TSpriteEngine; |
34 | FEngine: TSpriteEngine; |
| 23 | FParent: TSprite; |
35 | FParent: TSprite; |
| 24 | FList: TList; |
36 | FList: TList; |
| 25 | FDeaded: Boolean; |
37 | FDeaded: Boolean; |
| Line 30... | Line 42... | ||
| 30 | FX: Double; |
42 | FX: Double; |
| 31 | FY: Double; |
43 | FY: Double; |
| 32 | FZ: Integer; |
44 | FZ: Integer; |
| 33 | FWidth: Integer; |
45 | FWidth: Integer; |
| 34 | FHeight: 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; |
|
| 35 | procedure Add(Sprite: TSprite); |
62 | procedure Add(Sprite: TSprite); |
| 36 | procedure Remove(Sprite: TSprite); |
63 | procedure Remove(Sprite: TSprite); |
| 37 | procedure AddDrawList(Sprite: TSprite); |
64 | procedure AddDrawList(Sprite: TSprite); |
| 38 | procedure Collision2; |
65 | procedure Collision2; |
| 39 | procedure Draw; |
66 | procedure Draw; {$IFDEF VER9UP}inline;{$ENDIF} |
| 40 | function GetClientRect: TRect; |
67 | function GetClientRect: TRect; |
| 41 | function GetCount: Integer; |
68 | function GetCount: Integer; |
| 42 | function GetItem(Index: Integer): TSprite; |
69 | function GetItem(Index: Integer): TSprite; |
| 43 | function GetWorldX: Double; |
70 | function GetWorldX: Double; {$IFDEF VER9UP}inline;{$ENDIF} |
| 44 | function GetWorldY: Double; |
71 | function GetWorldY: Double; {$IFDEF VER9UP}inline;{$ENDIF} |
| 45 | procedure SetZ(Value: Integer); |
72 | procedure SetZ(Value: Integer); |
| 46 | protected |
73 | protected |
| 47 | procedure DoCollision(Sprite: TSprite; var Done: Boolean); virtual; |
74 | procedure DoCollision(Sprite: TSprite; var Done: Boolean); virtual; |
| 48 | procedure DoDraw; virtual; |
75 | procedure DoDraw; virtual; |
| 49 | procedure DoMove(MoveCount: Integer); virtual; |
76 | procedure DoMove(MoveCount: Integer); virtual; |
| 50 | function GetBoundsRect: TRect; virtual; |
77 | function GetBoundsRect: TRect; virtual; |
| 51 | function TestCollision(Sprite: TSprite): Boolean; 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} |
|
| 52 | public |
83 | public |
| 53 | constructor Create(AParent: TSprite); virtual; |
84 | constructor Create(AParent: TSprite); virtual; |
| 54 | destructor Destroy; override; |
85 | destructor Destroy; override; |
| 55 | procedure Clear; |
86 | procedure Clear; |
| 56 | function Collision: Integer; |
87 | function Collision: Integer; |
| 57 | procedure Dead; |
88 | procedure Dead; |
| 58 | procedure Move(MoveCount: Integer); |
89 | procedure Move(MoveCount: Integer); |
| - | 90 | procedure ReAnimate(MoveCount: Integer); virtual; |
|
| 59 | function GetSpriteAt(X, Y: Integer): TSprite; |
91 | function GetSpriteAt(X, Y: Integer): TSprite; |
| 60 | property BoundsRect: TRect read GetBoundsRect; |
92 | property BoundsRect: TRect read GetBoundsRect; |
| 61 | property ClientRect: TRect read GetClientRect; |
93 | property ClientRect: TRect read GetClientRect; |
| 62 | property Collisioned: Boolean read FCollisioned write FCollisioned; |
- | |
| 63 | property Count: Integer read GetCount; |
94 | property Count: Integer read GetCount; |
| 64 | property Engine: TSpriteEngine read FEngine; |
95 | property Engine: TSpriteEngine read FEngine; |
| 65 | property Items[Index: Integer]: TSprite read GetItem; default; |
96 | property Items[Index: Integer]: TSprite read GetItem; default; |
| 66 | property Moved: Boolean read FMoved write FMoved; |
97 | property Deaded: Boolean read FDeaded; |
| 67 | property Parent: TSprite read FParent; |
98 | property Parent: TSprite read FParent; |
| 68 | property Visible: Boolean read FVisible write FVisible; |
- | |
| 69 | property Width: Integer read FWidth write FWidth; |
- | |
| 70 | property WorldX: Double read GetWorldX; |
99 | property WorldX: Double read GetWorldX; |
| 71 | property WorldY: Double read GetWorldY; |
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 |
|
| 72 | property Height: Integer read FHeight write FHeight; |
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; |
|
| 73 | property X: Double read FX write FX; |
112 | property X: Double read FX write FX; |
| 74 | property Y: Double read FY write FY; |
113 | property Y: Double read FY write FY; |
| 75 | property Z: Integer read FZ write SetZ; |
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; |
|
| 76 | end; |
126 | end; |
| 77 | 127 | ||
| - | 128 | TSpriteClass = class of TSprite; |
|
| - | 129 | ||
| 78 | { TImageSprite } |
130 | { TImageSprite } |
| 79 | 131 | ||
| 80 | TImageSprite = class(TSprite) |
132 | TImageSprite = class(TSprite) |
| 81 | private |
133 | private |
| 82 | FAnimCount: Integer; |
134 | FAnimCount: Integer; |
| 83 | FAnimLooped: Boolean; |
135 | FAnimLooped: Boolean; |
| 84 | FAnimPos: Double; |
136 | FAnimPos: Double; |
| 85 | FAnimSpeed: Double; |
137 | FAnimSpeed: Double; |
| 86 | FAnimStart: Integer; |
138 | FAnimStart: Integer; |
| 87 | FImage: TPictureCollectionItem; |
- | |
| 88 | FPixelCheck: Boolean; |
139 | FPixelCheck: Boolean; |
| 89 | FTile: Boolean; |
140 | FTile: Boolean; |
| 90 | FTransparent: 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; |
|
| 91 | function GetDrawImageIndex: Integer; |
151 | function GetDrawImageIndex: Integer; |
| 92 | function GetDrawRect: TRect; |
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); |
|
| 93 | protected |
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; |
|
| 94 | procedure DoDraw; override; |
198 | procedure DoDraw; override; |
| 95 | procedure DoMove(MoveCount: Integer); override; |
199 | procedure DoMove(MoveCount: Integer); override; |
| 96 | function GetBoundsRect: TRect; override; |
200 | function GetBoundsRect: TRect; override; |
| 97 | function TestCollision(Sprite: TSprite): Boolean; override; |
201 | function TestCollision(Sprite: TSprite): Boolean; override; |
| - | 202 | procedure SetImage(AImage: TPictureCollectionItem); virtual; |
|
| 98 | public |
203 | public |
| 99 | constructor Create(AParent: TSprite); override; |
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; |
|
| 100 | property AnimCount: Integer read FAnimCount write FAnimCount; |
215 | property AnimCount: Integer read FAnimCount write FAnimCount default 0; |
| 101 | property AnimLooped: Boolean read FAnimLooped write FAnimLooped; |
216 | property AnimLooped: Boolean read FAnimLooped write FAnimLooped default False; |
| 102 | property AnimPos: Double read FAnimPos write FAnimPos; |
217 | property AnimPos: Double read FAnimPos write FAnimPos; |
| 103 | property AnimSpeed: Double read FAnimSpeed write FAnimSpeed; |
218 | property AnimSpeed: Double read FAnimSpeed write FAnimSpeed; |
| 104 | property AnimStart: Integer read FAnimStart write FAnimStart; |
219 | property AnimStart: Integer read FAnimStart write FAnimStart default 0; |
| 105 | property PixelCheck: Boolean read FPixelCheck write FPixelCheck; |
220 | property PixelCheck: Boolean read FPixelCheck write FPixelCheck default False; |
| 106 | property Image: TPictureCollectionItem read FImage write FImage; |
221 | property Tile: Boolean read FTile write FTile default False; |
| 107 | property Tile: Boolean read FTile write FTile; |
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; |
|
| 108 | end; |
233 | end; |
| 109 | 234 | ||
| 110 | { TImageSpriteEx } |
235 | { TImageSpriteEx } |
| 111 | 236 | ||
| 112 | TImageSpriteEx = class(TImageSprite) |
237 | TImageSpriteEx = class(TImageSprite) |
| 113 | private |
- | |
| 114 | FAngle: Integer; |
- | |
| 115 | FAlpha: Integer; |
- | |
| 116 | protected |
- | |
| 117 | procedure DoDraw; override; |
- | |
| 118 | function GetBoundsRect: TRect; override; |
- | |
| 119 | function TestCollision(Sprite: TSprite): Boolean; override; |
238 | end{$IFDEF VER9UP}deprecated{$IFDEF VER14UP} 'Use for backward compatibility only or replace by TImageSprite instead...'{$ENDIF}{$ENDIF}; |
| 120 | public |
- | |
| 121 | constructor Create(AParent: TSprite); override; |
- | |
| 122 | property Angle: Integer read FAngle write FAngle; |
- | |
| 123 | property Alpha: Integer read FAlpha write FAlpha; |
- | |
| 124 | end; |
- | |
| 125 | 239 | ||
| 126 | { TBackgroundSprite } |
240 | { TBackgroundSprite } |
| 127 | 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 | ||
| 128 | TBackgroundSprite = class(TSprite) |
261 | TBackgroundSprite = class(TImageSprite) |
| 129 | private |
262 | private |
| 130 | FImage: TPictureCollectionItem; |
- | |
| 131 | FCollisionMap: Pointer; |
- | |
| 132 | FMap: Pointer; |
263 | FMap: Pointer; |
| 133 | FMapWidth: Integer; |
264 | FMapWidth: Integer; |
| 134 | FMapHeight: Integer; |
265 | FMapHeight: Integer; |
| - | 266 | ||
| 135 | FTile: Boolean; |
267 | FChipsRect: TRect; |
| - | 268 | FChipsPatternIndex: Integer; |
|
| 136 | function GetCollisionMapItem(X, Y: Integer): Boolean; |
269 | function GetCollisionMapItem(X, Y: Integer): Boolean; |
| 137 | function GetChip(X, Y: Integer): Integer; |
270 | function GetChip(X, Y: Integer): Integer; |
| 138 | procedure SetChip(X, Y: Integer; Value: Integer); |
271 | procedure SetChip(X, Y: Integer; Value: Integer); |
| 139 | procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean); |
272 | procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean); |
| 140 | procedure SetMapHeight(Value: Integer); |
273 | procedure SetMapHeight(Value: Integer); |
| 141 | procedure SetMapWidth(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); |
|
| 142 | protected |
284 | protected |
| - | 285 | procedure ReadMapData(Stream: TStream); |
|
| - | 286 | procedure WriteMapData(Stream: TStream); |
|
| 143 | procedure DoDraw; override; |
287 | procedure DoDraw; override; |
| 144 | function GetBoundsRect: TRect; override; |
288 | function GetBoundsRect: TRect; override; |
| 145 | function TestCollision(Sprite: TSprite): Boolean; override; |
289 | function TestCollision(Sprite: TSprite): Boolean; override; |
| - | 290 | procedure SetImage(Img: TPictureCollectionItem); override; |
|
| - | 291 | procedure DefineProperties(Filer: TFiler); override; |
|
| 146 | public |
292 | public |
| 147 | constructor Create(AParent: TSprite); override; |
293 | constructor Create(AParent: TSprite); override; |
| 148 | destructor Destroy; override; |
294 | destructor Destroy; override; |
| - | 295 | procedure ChipsDraw(Image: TPictureCollectionItem; X, Y, PatternIndex: Integer); |
|
| 149 | procedure SetMapSize(AMapWidth, AMapHeight: Integer); |
296 | procedure SetMapSize(AMapWidth, AMapHeight: Integer); |
| - | 297 | function IsMapEmpty: Boolean; |
|
| 150 | property Chips[X, Y: Integer]: Integer read GetChip write SetChip; |
298 | property Chips[X, Y: Integer]: Integer read GetChip write SetChip; |
| 151 | property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem; |
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; |
|
| 152 | property Image: TPictureCollectionItem read FImage write FImage; |
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} |
|
| 153 | property MapHeight: Integer read FMapHeight write SetMapHeight; |
308 | property MapHeight: Integer read FMapHeight write SetMapHeight; |
| 154 | property MapWidth: Integer read FMapWidth write SetMapWidth; |
309 | property MapWidth: Integer read FMapWidth write SetMapWidth; |
| - | 310 | published |
|
| - | 311 | property DXImageList; |
|
| - | 312 | property DXImageName; |
|
| - | 313 | ||
| - | 314 | property OnDraw; |
|
| - | 315 | property OnMove; |
|
| 155 | property Tile: Boolean read FTile write FTile; |
316 | property OnCollision; |
| - | 317 | property OnGetImage; |
|
| 156 | end; |
318 | end; |
| 157 | 319 | ||
| - | 320 | { forward class } |
|
| - | 321 | ||
| - | 322 | TCustomDXSpriteEngine = class; |
|
| - | 323 | ||
| 158 | { TSpriteEngine } |
324 | { TSpriteEngine } |
| 159 | 325 | ||
| 160 | TSpriteEngine = class(TSprite) |
326 | TSpriteEngine = class(TSprite) |
| 161 | private |
327 | private |
| - | 328 | FOwner: TCustomDXSpriteEngine; |
|
| 162 | FAllCount: Integer; |
329 | FAllCount: Integer; |
| 163 | FCollisionCount: Integer; |
330 | FCollisionCount: Integer; |
| 164 | FCollisionDone: Boolean; |
331 | FCollisionDone: Boolean; |
| 165 | FCollisionRect: TRect; |
332 | FCollisionRect: TRect; |
| 166 | FCollisionSprite: TSprite; |
333 | FCollisionSprite: TSprite; |
| 167 | FDeadList: TList; |
334 | FDeadList: TList; |
| 168 | FDrawCount: Integer; |
335 | FDrawCount: Integer; |
| 169 | FSurface: TDirectDrawSurface; |
336 | FSurface: TDirectDrawSurface; |
| 170 | FSurfaceRect: TRect; |
337 | FSurfaceRect: TRect; |
| - | 338 | {$IFDEF Ver4Up} |
|
| - | 339 | FObjectsSelected: Boolean; |
|
| - | 340 | FGroupCount: Integer; |
|
| - | 341 | FGroups: array of Tlist; |
|
| - | 342 | FCurrentSelected: Tlist; |
|
| - | 343 | {$ENDIF} |
|
| - | 344 | protected |
|
| 171 | procedure SetSurface(Value: TDirectDrawSurface); |
345 | procedure SetSurface(Value: TDirectDrawSurface); virtual; |
| - | 346 | {$IFDEF Ver4Up} |
|
| - | 347 | procedure SetGroupCount(AGroupCount: Integer); virtual; |
|
| - | 348 | function GetGroup(Index: Integer): Tlist; virtual; |
|
| - | 349 | {$ENDIF} |
|
| 172 | public |
350 | public |
| 173 | constructor Create(AParent: TSprite); override; |
351 | constructor Create(AParent: TSprite); override; |
| 174 | destructor Destroy; override; |
352 | destructor Destroy; override; |
| 175 | procedure Dead; |
353 | procedure Dead; |
| 176 | procedure Draw; |
354 | procedure Draw; |
| 177 | property AllCount: Integer read FAllCount; |
355 | property AllCount: Integer read FAllCount; |
| 178 | property DrawCount: Integer read FDrawCount; |
356 | property DrawCount: Integer read FDrawCount; |
| 179 | property Surface: TDirectDrawSurface read FSurface write SetSurface; |
357 | property Surface: TDirectDrawSurface read FSurface write SetSurface; |
| 180 | property SurfaceRect: TRect read FSurfaceRect; |
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} |
|
| 181 | end; |
379 | end; |
| 182 | 380 | ||
| 183 | { EDXSpriteEngineError } |
381 | { EDXSpriteEngineError } |
| 184 | 382 | ||
| 185 | EDXSpriteEngineError = class(Exception); |
383 | EDXSpriteEngineError = class(Exception); |
| 186 | 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 | ||
| 187 | { TCustomDXSpriteEngine } |
469 | { TCustomDXSpriteEngine } |
| 188 | 470 | ||
| 189 | TCustomDXSpriteEngine = class(TComponent) |
471 | TCustomDXSpriteEngine = class(TComponent) |
| 190 | private |
472 | private |
| 191 | FDXDraw: TCustomDXDraw; |
473 | FDXDraw: TCustomDXDraw; |
| 192 | FEngine: TSpriteEngine; |
474 | FEngine: TSpriteEngine; |
| - | 475 | FItems: TSpriteCollection; |
|
| 193 | procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType); |
476 | procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType); |
| 194 | procedure SetDXDraw(Value: TCustomDXDraw); |
477 | procedure SetDXDraw(Value: TCustomDXDraw); |
| - | 478 | procedure SetItems(const Value: TSpriteCollection); |
|
| 195 | protected |
479 | protected |
| 196 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
480 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
| 197 | public |
481 | public |
| 198 | constructor Create(AOnwer: TComponent); override; |
482 | constructor Create(AOwner: TComponent); override; |
| 199 | destructor Destroy; override; |
483 | destructor Destroy; override; |
| 200 | procedure Dead; |
484 | procedure Dead; |
| 201 | procedure Draw; |
485 | procedure Draw; |
| 202 | procedure Move(MoveCount: Integer); |
486 | procedure Move(MoveCount: Integer); |
| - | 487 | procedure Clone(const Amount: Word; const BaseNameOfSprite: string); |
|
| - | 488 | function ForEach(PrefixNameOdSprite: string; var Names: TStringList): Boolean; |
|
| 203 | property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw; |
489 | property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw; |
| 204 | property Engine: TSpriteEngine read FEngine; |
490 | property Engine: TSpriteEngine read FEngine; |
| - | 491 | property Items: TSpriteCollection read FItems write SetItems; |
|
| 205 | end; |
492 | end; |
| 206 | 493 | ||
| 207 | { TDXSpriteEngine } |
494 | { TDXSpriteEngine } |
| 208 | 495 | ||
| 209 | TDXSpriteEngine = class(TCustomDXSpriteEngine) |
496 | TDXSpriteEngine = class(TCustomDXSpriteEngine) |
| - | 497 | property Items; |
|
| 210 | published |
498 | published |
| 211 | property DXDraw; |
499 | property DXDraw; |
| 212 | end; |
500 | end; |
| 213 | 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 | ||
| 214 | implementation |
506 | implementation |
| 215 | 507 | ||
| 216 | uses DXConsts; |
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; |
|
| 217 | 535 | ||
| 218 | function Mod2(i, i2: Integer): Integer; |
536 | function Mod2(i, i2: Integer): Integer; |
| 219 | begin |
537 | begin |
| 220 | Result := i mod i2; |
538 | Result := i mod i2; |
| 221 | if Result<0 then |
539 | if Result < 0 then |
| Line 226... | Line 544... | ||
| 226 | begin |
544 | begin |
| 227 | if i2=0 then |
545 | if i2 = 0 then |
| 228 | Result := i |
546 | Result := i |
| 229 | else |
547 | else |
| 230 | begin |
548 | begin |
| 231 | Result := i-Trunc(i/i2)*i2; |
549 | Result := i - Round(i / i2) * i2; |
| 232 | if Result<0 then |
550 | if Result < 0 then |
| 233 | Result := i2+Result; |
551 | Result := i2 + Result; |
| 234 | end; |
552 | end; |
| 235 | end; |
553 | end; |
| 236 | 554 | ||
| 237 | { TSprite } |
555 | { TSprite } |
| 238 | 556 | ||
| 239 | constructor TSprite.Create(AParent: TSprite); |
557 | constructor TSprite.Create(AParent: TSprite); |
| 240 | begin |
558 | begin |
| 241 | inherited Create; |
559 | inherited Create; |
| - | 560 | {$IFDEF Ver4Up} |
|
| - | 561 | fGroupnumber := -1; |
|
| - | 562 | {$ENDIF} |
|
| 242 | FParent := AParent; |
563 | FParent := AParent; |
| 243 | if FParent<>nil then |
564 | if FParent <> nil then |
| 244 | begin |
565 | begin |
| 245 | FParent.Add(Self); |
566 | FParent.Add(Self); |
| 246 | if FParent is TSpriteEngine then |
567 | if FParent is TSpriteEngine then |
| Line 255... | Line 576... | ||
| 255 | FVisible := True; |
576 | FVisible := True; |
| 256 | end; |
577 | end; |
| 257 | 578 | ||
| 258 | destructor TSprite.Destroy; |
579 | destructor TSprite.Destroy; |
| 259 | begin |
580 | begin |
| - | 581 | {$IFDEF Ver4Up} |
|
| - | 582 | GroupNumber := -1; |
|
| - | 583 | Selected := False; |
|
| - | 584 | {$ENDIF} |
|
| 260 | Clear; |
585 | Clear; |
| 261 | if FParent<>nil then |
586 | if FParent <> nil then |
| 262 | begin |
587 | begin |
| 263 | Dec(FEngine.FAllCount); |
588 | Dec(FEngine.FAllCount); |
| 264 | FParent.Remove(Self); |
589 | FParent.Remove(Self); |
| Line 267... | Line 592... | ||
| 267 | FList.Free; |
592 | FList.Free; |
| 268 | FDrawList.Free; |
593 | FDrawList.Free; |
| 269 | inherited Destroy; |
594 | inherited Destroy; |
| 270 | end; |
595 | end; |
| 271 | 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 | ||
| 272 | procedure TSprite.Add(Sprite: TSprite); |
624 | procedure TSprite.Add(Sprite: TSprite); |
| 273 | begin |
625 | begin |
| 274 | if FList=nil then |
626 | if FList = nil then |
| 275 | begin |
627 | begin |
| 276 | FList := TList.Create; |
628 | FList := TList.Create; |
| Line 301... | Line 653... | ||
| 301 | H := FDrawList.Count - 1; |
653 | H := FDrawList.Count - 1; |
| 302 | while L <= H do |
654 | while L <= H do |
| 303 | begin |
655 | begin |
| 304 | I := (L + H) div 2; |
656 | I := (L + H) div 2; |
| 305 | C := TSprite(FDrawList[I]).Z-Sprite.Z; |
657 | C := TSprite(FDrawList[I]).Z - Sprite.Z; |
| 306 | if C < 0 then L := I + 1 else |
658 | if C < 0 then |
| - | 659 | L := I + 1 |
|
| - | 660 | else |
|
| 307 | H := I - 1; |
661 | H := I - 1; |
| 308 | end; |
662 | end; |
| 309 | FDrawList.Insert(L, Sprite); |
663 | FDrawList.Insert(L, Sprite); |
| 310 | end; |
664 | end; |
| 311 | 665 | ||
| Line 341... | Line 695... | ||
| 341 | var |
695 | var |
| 342 | i: Integer; |
696 | i: Integer; |
| 343 | begin |
697 | begin |
| 344 | if Collisioned then |
698 | if Collisioned then |
| 345 | begin |
699 | begin |
| 346 | if (Self<>FEngine.FCollisionSprite) and OverlapRect(BoundsRect, FEngine.FCollisionRect) and |
700 | if (Self <> FEngine.FCollisionSprite) and OverlapRect(BoundsRect, |
| 347 | FEngine.FCollisionSprite.TestCollision(Self) and TestCollision(FEngine.FCollisionSprite) then |
701 | FEngine.FCollisionRect) and FEngine.FCollisionSprite.TestCollision(Self) and |
| - | 702 | TestCollision(FEngine.FCollisionSprite) then |
|
| 348 | begin |
703 | begin |
| 349 | Inc(FEngine.FCollisionCount); |
704 | Inc(FEngine.FCollisionCount); |
| 350 | FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone); |
705 | FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone); |
| 351 | if (not FEngine.FCollisionSprite.Collisioned) or (FEngine.FCollisionSprite.FDeaded) then |
706 | if (not FEngine.FCollisionSprite.Collisioned) or |
| - | 707 | (FEngine.FCollisionSprite.FDeaded) then |
|
| 352 | begin |
708 | begin |
| 353 | FEngine.FCollisionDone := True; |
709 | FEngine.FCollisionDone := True; |
| 354 | end; |
710 | end; |
| 355 | end; |
711 | end; |
| 356 | if FEngine.FCollisionDone then Exit; |
712 | if FEngine.FCollisionDone then |
| - | 713 | Exit; |
|
| 357 | for i:=0 to Count-1 do |
714 | for i := 0 to Count - 1 do |
| 358 | Items[i].Collision2; |
715 | Items[i].Collision2; |
| 359 | end; |
716 | end; |
| 360 | end; |
717 | end; |
| 361 | 718 | ||
| Line 366... | Line 723... | ||
| 366 | FDeaded := True; |
723 | FDeaded := True; |
| 367 | FEngine.FDeadList.Add(Self); |
724 | FEngine.FDeadList.Add(Self); |
| 368 | end; |
725 | end; |
| 369 | end; |
726 | end; |
| 370 | 727 | ||
| 371 | procedure TSprite.DoMove; |
728 | procedure TSprite.DoMove(MoveCount: Integer); |
| 372 | begin |
729 | begin |
| - | 730 | if AsSigned(FOnMove) then |
|
| - | 731 | FOnMove(Self, MoveCount); |
|
| 373 | end; |
732 | end; |
| 374 | 733 | ||
| 375 | procedure TSprite.DoDraw; |
734 | procedure TSprite.DoDraw; |
| 376 | begin |
735 | begin |
| - | 736 | if AsSigned(FOnDraw) then |
|
| - | 737 | FOnDraw(Self); |
|
| 377 | end; |
738 | end; |
| 378 | 739 | ||
| 379 | procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean); |
740 | procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean); |
| 380 | begin |
741 | begin |
| - | 742 | if AsSigned(FOnCollision) then |
|
| - | 743 | FOnCollision(Sprite, Done); |
|
| 381 | end; |
744 | end; |
| 382 | 745 | ||
| 383 | function TSprite.TestCollision(Sprite: TSprite): Boolean; |
746 | function TSprite.TestCollision(Sprite: TSprite): Boolean; |
| 384 | begin |
747 | begin |
| 385 | Result := True; |
748 | Result := True; |
| Line 389... | Line 752... | ||
| 389 | var |
752 | var |
| 390 | i: Integer; |
753 | i: Integer; |
| 391 | begin |
754 | begin |
| 392 | if FMoved then |
755 | if FMoved then |
| 393 | begin |
756 | begin |
| 394 | DoMove(MoveCount); |
757 | DoMove(MoveCount); ReAnimate(MoveCount); |
| 395 | for i:=0 to Count-1 do |
758 | for i := 0 to Count - 1 do |
| 396 | Items[i].Move(MoveCount); |
759 | Items[i].Move(MoveCount); |
| 397 | end; |
760 | end; |
| 398 | end; |
761 | end; |
| 399 | 762 | ||
| Line 413... | Line 776... | ||
| 413 | end; |
776 | end; |
| 414 | 777 | ||
| 415 | if FDrawList<>nil then |
778 | if FDrawList <> nil then |
| 416 | begin |
779 | begin |
| 417 | for i:=0 to FDrawList.Count-1 do |
780 | for i := 0 to FDrawList.Count - 1 do |
| - | 781 | begin |
|
| 418 | TSprite(FDrawList[i]).Draw; |
782 | TSprite(FDrawList[i]).Draw; |
| 419 | end; |
783 | end; |
| 420 | end; |
784 | end; |
| 421 | end; |
785 | end; |
| - | 786 | end; |
|
| 422 | 787 | ||
| 423 | function TSprite.GetSpriteAt(X, Y: Integer): TSprite; |
788 | function TSprite.GetSpriteAt(X, Y: Integer): TSprite; |
| 424 | 789 | ||
| 425 | procedure Collision_GetSpriteAt(X, Y: Double; Sprite: TSprite); |
790 | procedure Collision_GetSpriteAt(X, Y: Double; Sprite: TSprite); |
| 426 | var |
791 | var |
| 427 | i: Integer; |
792 | i: Integer; |
| 428 | X2, Y2: Double; |
793 | X2, Y2: Double; |
| 429 | begin |
794 | begin |
| - | 795 | if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)), |
|
| 430 | if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)), Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Width)) then |
796 | Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Height)) then //corrected by Sergey |
| 431 | begin |
797 | begin |
| 432 | if (Result=nil) or (Sprite.Z>Result.Z) then |
798 | if (Result = nil) or (Sprite.Z > Result.Z) then |
| 433 | Result := Sprite; |
799 | Result := Sprite; |
| 434 | end; |
800 | end; |
| 435 | 801 | ||
| Line 451... | Line 817... | ||
| 451 | Collision_GetSpriteAt(X2, Y2, Items[i]); |
817 | Collision_GetSpriteAt(X2, Y2, Items[i]); |
| 452 | end; |
818 | end; |
| 453 | 819 | ||
| 454 | function TSprite.GetBoundsRect: TRect; |
820 | function TSprite.GetBoundsRect: TRect; |
| 455 | begin |
821 | begin |
| 456 | Result := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height); |
822 | Result := Bounds(Round(WorldX), Round(WorldY), Width, Height); |
| 457 | end; |
823 | end; |
| 458 | 824 | ||
| 459 | function TSprite.GetClientRect: TRect; |
825 | function TSprite.GetClientRect: TRect; |
| 460 | begin |
826 | begin |
| 461 | Result := Bounds(0, 0, Width, Height); |
827 | Result := Bounds(0, 0, Width, Height); |
| Line 504... | Line 870... | ||
| 504 | Parent.AddDrawList(Self); |
870 | Parent.AddDrawList(Self); |
| 505 | end; |
871 | end; |
| 506 | end; |
872 | end; |
| 507 | end; |
873 | end; |
| 508 | 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 | ||
| 509 | { TImageSprite } |
910 | { TImageSprite } |
| 510 | 911 | ||
| 511 | constructor TImageSprite.Create(AParent: TSprite); |
912 | constructor TImageSprite.Create(AParent: TSprite); |
| 512 | begin |
913 | begin |
| 513 | inherited Create(AParent); |
914 | inherited Create(AParent); |
| 514 | FTransparent := True; |
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; |
|
| 515 | end; |
940 | end; |
| - | 941 | end; {SetImage} |
|
| 516 | 942 | ||
| 517 | function TImageSprite.GetBoundsRect: TRect; |
943 | function TImageSprite.GetBoundsRect: TRect; |
| 518 | var |
944 | var |
| 519 | dx, dy: Integer; |
945 | dx, dy: Integer; |
| 520 | begin |
946 | begin |
| 521 | dx := Trunc(WorldX); |
947 | dx := Round(WorldX); |
| 522 | dy := Trunc(WorldY); |
948 | dy := Round(WorldY); |
| 523 | if FTile then |
949 | if FTile then |
| 524 | begin |
950 | begin |
| 525 | dx := Mod2(dx, FEngine.SurfaceRect.Right+Width); |
951 | dx := Mod2(dx, FEngine.SurfaceRect.Right + Width); |
| 526 | dy := Mod2(dy, FEngine.SurfaceRect.Bottom+Height); |
952 | dy := Mod2(dy, FEngine.SurfaceRect.Bottom + Height); |
| 527 | 953 | ||
| Line 535... | Line 961... | ||
| 535 | Result := Bounds(dx, dy, Width, Height); |
961 | Result := Bounds(dx, dy, Width, Height); |
| 536 | end; |
962 | end; |
| 537 | 963 | ||
| 538 | procedure TImageSprite.DoMove(MoveCount: Integer); |
964 | procedure TImageSprite.DoMove(MoveCount: Integer); |
| 539 | begin |
965 | begin |
| 540 | FAnimPos := FAnimPos + FAnimSpeed*MoveCount; |
- | |
| 541 | - | ||
| 542 | if FAnimLooped then |
966 | if AsSigned(FOnMove) then |
| 543 | begin |
- | |
| 544 | if FAnimCount>0 then |
- | |
| 545 | FAnimPos := Mod2f(FAnimPos, FAnimCount) |
967 | FOnMove(Self, MoveCount) |
| 546 | else |
968 | else |
| 547 | FAnimPos := 0; |
- | |
| 548 | end else |
- | |
| 549 | begin |
- | |
| 550 | if FAnimPos>=FAnimCount then |
- | |
| 551 | begin |
969 | begin |
| 552 | FAnimPos := FAnimCount-1; |
970 | ReAnimate(MoveCount); |
| 553 | FAnimSpeed := 0; |
- | |
| 554 | end; |
- | |
| 555 | if FAnimPos<0 then |
- | |
| 556 | begin |
- | |
| 557 | FAnimPos := 0; |
- | |
| 558 | FAnimSpeed := 0; |
- | |
| 559 | end; |
- | |
| 560 | end; |
971 | end; |
| 561 | end; |
972 | end; |
| 562 | 973 | ||
| 563 | function TImageSprite.GetDrawImageIndex: Integer; |
974 | function TImageSprite.GetDrawImageIndex: Integer; |
| 564 | begin |
975 | begin |
| 565 | Result := FAnimStart+Trunc(FAnimPos); |
976 | Result := FAnimStart + Trunc(FAnimPos); //solve 1.07f to Round() |
| 566 | end; |
977 | end; |
| 567 | 978 | ||
| 568 | function TImageSprite.GetDrawRect: TRect; |
979 | function TImageSprite.GetDrawRect: TRect; |
| 569 | begin |
980 | begin |
| 570 | Result := BoundsRect; |
981 | Result := BoundsRect; |
| 571 | OffsetRect(Result, (Width-Image.Width) div 2, (Height-Image.Height) div 2); |
982 | OffsetRect(Result, (Width - Image.Width) div 2, (Height - Image.Height) div 2); |
| 572 | end; |
983 | end; |
| 573 | 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 | ||
| 574 | procedure TImageSprite.DoDraw; |
1005 | procedure TImageSprite.DoDraw; |
| 575 | var |
1006 | var |
| 576 | ImageIndex: Integer; |
- | |
| 577 | r: TRect; |
1007 | r: TRect; |
| 578 | begin |
1008 | begin |
| - | 1009 | LoadImage; |
|
| - | 1010 | if Image = nil then |
|
| - | 1011 | Exit; |
|
| 579 | ImageIndex := GetDrawImageIndex; |
1012 | if AsSigned(FOnDraw) then {owner draw called here} |
| 580 | r := GetDrawRect; |
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 |
|
| 581 | Image.Draw(FEngine.Surface, r.Left, r.Top, ImageIndex); |
1019 | DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, r, GetDrawImageIndex, |
| - | 1020 | FBlurImageArr, FBlurImage, FTextureFilter, FMirrorFlip, FBlendMode, FAngle, |
|
| - | 1021 | FAlpha, FCenterX, FCenterY); |
|
| - | 1022 | end; |
|
| 582 | end; |
1023 | end; |
| 583 | 1024 | ||
| - | 1025 | {$WARNINGS OFF} |
|
| - | 1026 | {$HINTS OFF} |
|
| - | 1027 | ||
| 584 | function ImageCollisionTest(suf1, suf2: TDirectDrawSurface; const rect1, rect2: TRect; |
1028 | function TImageSprite.ImageCollisionTest(suf1, suf2: TDirectDrawSurface; |
| 585 | x1,y1,x2,y2: Integer; DoPixelCheck: Boolean): Boolean; |
1029 | const rect1, rect2: TRect; x1, y1, x2, y2: Integer; DoPixelCheck: Boolean): Boolean; |
| 586 | 1030 | ||
| 587 | function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean; |
1031 | function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean; |
| 588 | begin |
1032 | begin |
| 589 | with DestRect do |
1033 | with DestRect do |
| 590 | begin |
1034 | begin |
| Line 597... | Line 1041... | ||
| 597 | end; |
1041 | end; |
| 598 | end; |
1042 | end; |
| 599 | 1043 | ||
| 600 | type |
1044 | type |
| 601 | PRGB = ^TRGB; |
1045 | PRGB = ^TRGB; |
| - | 1046 | ||
| 602 | TRGB = packed record |
1047 | TRGB = packed record |
| 603 | R, G, B: Byte; |
1048 | R, G, B: byte; |
| 604 | end; |
1049 | end; |
| 605 | var |
1050 | var |
| 606 | ddsd1, ddsd2: TDDSurfaceDesc; |
1051 | ddsd1, ddsd2: {$IFDEF D3D_deprecated}TDDSURFACEDESC{$ELSE}TDDSurfaceDesc2{$ENDIF}; |
| 607 | r1, r2: TRect; |
1052 | r1, r2, r1a, r2a: TRect; |
| 608 | tc1, tc2: DWORD; |
1053 | tc1, tc2: DWORD; |
| 609 | x, y, w, h: Integer; |
1054 | x, y, w, h: Integer; |
| 610 | P1, P2: Pointer; |
1055 | P1, P2: Pointer; |
| 611 | begin |
1056 | begin |
| - | 1057 | with rect1 do |
|
| - | 1058 | r1 := Bounds(0, 0, Right - Left, Bottom - Top); |
|
| 612 | r1 := rect1; |
1059 | r1a := r1; |
| - | 1060 | with rect2 do |
|
| - | 1061 | r2 := Bounds(0, 0, Right - Left, Bottom - Top); |
|
| - | 1062 | r2a := r2; |
|
| - | 1063 | ||
| - | 1064 | with rect2 do |
|
| 613 | with rect2 do r2 := Bounds(x2-x1, y2-y1, Right-Left, Bottom-Top); |
1065 | r2 := Bounds(x2 - x1, y2 - y1, Right - Left, Bottom - Top); |
| 614 | 1066 | ||
| 615 | Result := OverlapRect(r1, r2); |
1067 | Result := OverlapRect(r1, r2); |
| 616 | 1068 | ||
| 617 | if (suf1=nil) or (suf2=nil) then Exit; |
1069 | if (suf1 = nil) or (suf2 = nil) then |
| - | 1070 | Exit; |
|
| 618 | 1071 | ||
| 619 | if DoPixelCheck and Result then |
1072 | if DoPixelCheck and Result then |
| 620 | begin |
1073 | begin |
| 621 | { Get Overlapping rectangle } |
1074 | { Get Overlapping rectangle } |
| - | 1075 | with r1 do |
|
| 622 | with r1 do r1 := Bounds(Max(x2-x1, 0), Max(y2-y1, 0), Right-Left, Bottom-Top); |
1076 | r1 := Bounds(Max(x2 - x1, 0), Max(y2 - y1, 0), Right - Left, Bottom - Top); |
| - | 1077 | with r2 do |
|
| 623 | with r2 do r2 := Bounds(Max(x1-x2, 0), Max(y1-y2, 0), Right-Left, Bottom-Top); |
1078 | r2 := Bounds(Max(x1 - x2, 0), Max(y1 - y2, 0), Right - Left, Bottom - Top); |
| 624 | 1079 | ||
| 625 | ClipRect(r1, rect1); |
1080 | ClipRect(r1, r1a); |
| 626 | ClipRect(r2, rect2); |
1081 | ClipRect(r2, r2a); |
| 627 | 1082 | ||
| 628 | w := Min(r1.Right-r1.Left, r2.Right-r2.Left); |
1083 | w := Min(r1.Right - r1.Left, r2.Right - r2.Left); |
| 629 | h := Min(r1.Bottom-r1.Top, r2.Bottom-r2.Top); |
1084 | h := Min(r1.Bottom - r1.Top, r2.Bottom - r2.Top); |
| 630 | 1085 | ||
| 631 | ClipRect(r1, bounds(r1.Left, r1.Top, w, h)); |
1086 | ClipRect(r1, bounds(r1.Left, r1.Top, w, h)); |
| 632 | ClipRect(r2, bounds(r2.Left, r2.Top, w, h)); |
1087 | ClipRect(r2, bounds(r2.Left, r2.Top, w, h)); |
| 633 | 1088 | ||
| 634 | { Pixel check !!! } |
1089 | { Pixel check !!! } |
| 635 | ddsd1.dwSize := SizeOf(ddsd1); |
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 | ||
| 636 | if suf1.Lock(r1, ddsd1) then |
1103 | if suf1.Lock(r1, ddsd1) then |
| 637 | begin |
1104 | begin |
| 638 | try |
1105 | try |
| 639 | ddsd2.dwSize := SizeOf(ddsd2); |
1106 | ddsd2.dwSize := SizeOf(ddsd2); |
| 640 | if (suf1=suf2) or suf2.Lock(r2, ddsd2) then |
1107 | if (suf1 = suf2) or suf2.Lock(r2, ddsd2) then |
| 641 | begin |
1108 | begin |
| 642 | try |
1109 | try |
| - | 1110 | {this line out: don't test pixel but rect only, its wrong} |
|
| 643 | if suf1=suf2 then ddsd2 := ddsd1; |
1111 | {if suf1=suf2 then ddsd2 := ddsd1;} |
| 644 | if ddsd1.ddpfPixelFormat.dwRGBBitCount<>ddsd2.ddpfPixelFormat.dwRGBBitCount then Exit; |
1112 | if ddsd1.ddpfPixelFormat.dwRGBBitCount <> ddsd2.ddpfPixelFormat.dwRGBBitCount then |
| - | 1113 | Exit; |
|
| 645 | 1114 | ||
| 646 | { Get transparent color } |
1115 | { Get transparent color } |
| 647 | tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue; |
1116 | tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue; |
| 648 | tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue; |
1117 | tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue; |
| 649 | 1118 | ||
| 650 | case ddsd1.ddpfPixelFormat.dwRGBBitCount of |
1119 | case ddsd1.ddpfPixelFormat.dwRGBBitCount of |
| - | 1120 | 8: |
|
| 651 | 8 : begin |
1121 | begin |
| 652 | for y:=0 to h-1 do |
1122 | for y := 0 to h - 1 do |
| 653 | begin |
1123 | begin |
| 654 | P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch); |
1124 | P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch); |
| 655 | P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch); |
1125 | P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch); |
| 656 | for x:=0 to w-1 do |
1126 | for x := 0 to w - 1 do |
| 657 | begin |
1127 | begin |
| 658 | if (PByte(P1)^<>tc1) and (PByte(P2)^<>tc2) then Exit; |
1128 | if (PByte(P1)^ <> tc1) and (PByte(P2)^ <> tc2) then |
| - | 1129 | Exit; |
|
| 659 | Inc(PByte(P1)); |
1130 | Inc(PByte(P1)); |
| 660 | Inc(PByte(P2)); |
1131 | Inc(PByte(P2)); |
| 661 | end; |
1132 | end; |
| 662 | end; |
1133 | end; |
| 663 | end; |
1134 | end; |
| - | 1135 | 16: |
|
| 664 | 16: begin |
1136 | begin |
| 665 | for y:=0 to h-1 do |
1137 | for y := 0 to h - 1 do |
| 666 | begin |
1138 | begin |
| 667 | P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch); |
1139 | P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch); |
| 668 | P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch); |
1140 | P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch); |
| 669 | for x:=0 to w-1 do |
1141 | for x := 0 to w - 1 do |
| 670 | begin |
1142 | begin |
| 671 | if (PWord(P1)^<>tc1) and (PWord(P2)^<>tc2) then Exit; |
1143 | if (PWord(P1)^ <> tc1) and (PWord(P2)^ <> tc2) then |
| - | 1144 | Exit; |
|
| 672 | Inc(PWord(P1)); |
1145 | Inc(PWord(P1)); |
| 673 | Inc(PWord(P2)); |
1146 | Inc(PWord(P2)); |
| 674 | end; |
1147 | end; |
| 675 | end; |
1148 | end; |
| 676 | end; |
1149 | end; |
| - | 1150 | 24: |
|
| 677 | 24: begin |
1151 | begin |
| 678 | for y:=0 to h-1 do |
1152 | for y := 0 to h - 1 do |
| 679 | begin |
1153 | begin |
| 680 | P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch); |
1154 | P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch); |
| 681 | P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch); |
1155 | P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch); |
| 682 | for x:=0 to w-1 do |
1156 | for x := 0 to w - 1 do |
| 683 | begin |
1157 | begin |
| - | 1158 | with PRGB(P1)^ do |
|
| 684 | if ((PRGB(P1)^.R shl 16) or (PRGB(P1)^.G shl 8) or PRGB(P1)^.B<>tc1) and |
1159 | if (R shl 16) or (G shl 8) or B <> tc1 then |
| - | 1160 | Exit; |
|
| - | 1161 | with PRGB(P2)^ do |
|
| 685 | ((PRGB(P2)^.R shl 16) or (PRGB(P2)^.G shl 8) or PRGB(P2)^.B<>tc2) then Exit; |
1162 | if (R shl 16) or (G shl 8) or B <> tc2 then |
| - | 1163 | Exit; |
|
| 686 | Inc(PRGB(P1)); |
1164 | Inc(PRGB(P1)); |
| 687 | Inc(PRGB(P2)); |
1165 | Inc(PRGB(P2)); |
| 688 | end; |
1166 | end; |
| 689 | end; |
1167 | end; |
| 690 | end; |
1168 | end; |
| - | 1169 | 32: |
|
| 691 | 32: begin |
1170 | begin |
| 692 | for y:=0 to h-1 do |
1171 | for y := 0 to h - 1 do |
| 693 | begin |
1172 | begin |
| 694 | P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch); |
1173 | P1 := Pointer(Integer(ddsd1.lpSurface) + y * ddsd1.lPitch); |
| 695 | P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch); |
1174 | P2 := Pointer(Integer(ddsd2.lpSurface) + y * ddsd2.lPitch); |
| 696 | for x:=0 to w-1 do |
1175 | for x := 0 to w - 1 do |
| 697 | begin |
1176 | begin |
| 698 | if (PDWORD(P1)^ and $FFFFFF<>tc1) and (PDWORD(P2)^ and $FFFFFF<>tc2) then Exit; |
1177 | if (PDWORD(P1)^ <> tc1) and (PDWORD(P2)^ <> tc2) then |
| - | 1178 | Exit; |
|
| 699 | Inc(PDWORD(P1)); |
1179 | Inc(PDWORD(P1)); |
| 700 | Inc(PDWORD(P2)); |
1180 | Inc(PDWORD(P2)); |
| 701 | end; |
1181 | end; |
| 702 | end; |
1182 | end; |
| 703 | end; |
1183 | end; |
| 704 | end; |
1184 | end; |
| 705 | finally |
1185 | finally |
| 706 | if suf1<>suf2 then suf2.UnLock; |
1186 | if suf1 <> suf2 then |
| - | 1187 | suf2.UnLock; |
|
| 707 | end; |
1188 | end; |
| 708 | end; |
1189 | end; |
| 709 | finally |
1190 | finally |
| 710 | suf1.UnLock; |
1191 | suf1.UnLock; |
| 711 | end; |
1192 | end; |
| Line 713... | Line 1194... | ||
| 713 | 1194 | ||
| 714 | Result := False; |
1195 | Result := False; |
| 715 | end; |
1196 | end; |
| 716 | end; |
1197 | end; |
| 717 | 1198 | ||
| - | 1199 | {$HINTS ON} |
|
| - | 1200 | {$WARNINGS ON} |
|
| - | 1201 | ||
| 718 | function TImageSprite.TestCollision(Sprite: TSprite): Boolean; |
1202 | function TImageSprite.TestCollision(Sprite: TSprite): Boolean; |
| 719 | var |
1203 | var |
| 720 | img1, img2: Integer; |
1204 | img1, img2: Integer; |
| 721 | b1, b2: TRect; |
1205 | box1, box2: TRect; |
| 722 | begin |
1206 | begin |
| 723 | if (Sprite is TImageSprite) and FPixelCheck then |
1207 | if (Sprite is TImageSprite) then |
| - | 1208 | if FPixelCheck then |
|
| 724 | begin |
1209 | begin |
| 725 | b1 := GetDrawRect; |
1210 | box1 := GetDrawRect; |
| 726 | b2 := TImageSprite(Sprite).GetDrawRect; |
1211 | box2 := TImageSprite(Sprite).GetDrawRect; |
| 727 | 1212 | ||
| 728 | img1 := GetDrawImageIndex; |
1213 | img1 := GetDrawImageIndex; |
| 729 | img2 := TImageSprite(Sprite).GetDrawImageIndex; |
1214 | img2 := TImageSprite(Sprite).GetDrawImageIndex; |
| 730 | 1215 | ||
| 731 | Result := ImageCollisionTest(Image.PatternSurfaces[img1], TImageSprite(Sprite).Image.PatternSurfaces[img2], |
1216 | Result := ImageCollisionTest(Image.PatternSurfaces[img1], |
| 732 | Image.PatternRects[img1], TImageSprite(Sprite).Image.PatternRects[img2], |
1217 | TImageSprite(Sprite).Image.PatternSurfaces[img2], Image.PatternRects[img1], |
| - | 1218 | TImageSprite(Sprite).Image.PatternRects[img2], box1.Left, box1.Top, |
|
| 733 | b1.Left, b1.Top, b2.Left, b2.Top, True); |
1219 | box2.Left, box2.Top, True); |
| - | 1220 | end |
|
| 734 | end else |
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 |
|
| 735 | Result := inherited TestCollision(Sprite); |
1225 | Result := inherited TestCollision(Sprite); |
| 736 | end; |
1226 | end; |
| 737 | 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; |
|
| 738 | { TImageSpriteEx } |
1247 | inherited; |
| - | 1248 | end; |
|
| - | 1249 | ||
| - | 1250 | procedure TImageSprite.ReAnimate(MoveCount: Integer); |
|
| - | 1251 | var |
|
| - | 1252 | I: Integer; |
|
| - | 1253 | begin |
|
| - | 1254 | FAnimPos := FAnimPos + FAnimSpeed * MoveCount; |
|
| 739 | 1255 | ||
| 740 | constructor TImageSpriteEx.Create(AParent: TSprite); |
1256 | if FAnimLooped then |
| 741 | begin |
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 |
|
| 742 | inherited Create(AParent); |
1308 | Result := FCenterY <> 0.5; |
| - | 1309 | end; |
|
| - | 1310 | ||
| - | 1311 | function TImageSprite.StoreAlpha: Boolean; |
|
| - | 1312 | begin |
|
| 743 | FAlpha := 255; |
1313 | Result := FAlpha <> 0.0; |
| 744 | end; |
1314 | end; |
| 745 | 1315 | ||
| 746 | procedure TImageSpriteEx.DoDraw; |
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); |
|
| 747 | var |
1337 | var |
| - | 1338 | q: TRenderMirrorFlip; |
|
| - | 1339 | s, ss: string; |
|
| 748 | r: TRect; |
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; |
|
| 749 | begin |
1361 | begin |
| - | 1362 | // PI := GetPropInfo(Self,'MirrorFlip'); |
|
| - | 1363 | // SetOrdProp(Self,PI,StringToSet(PI, Reader.ReadString)); |
|
| - | 1364 | qq := []; |
|
| - | 1365 | s := Reader.ReadString; |
|
| 750 | r := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height); |
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; |
|
| 751 | 1371 | ||
| 752 | if FAngle and $FF=0 then |
1372 | procedure TImageSprite.ReadAnimLooped(Reader: TReader); |
| 753 | begin |
1373 | begin |
| 754 | if FAlpha<255 then |
1374 | FAnimLooped := Reader.ReadBoolean; |
| - | 1375 | end; |
|
| - | 1376 | ||
| - | 1377 | procedure TImageSprite.WriteAnimLooped(Writer: TWriter); |
|
| 755 | begin |
1378 | begin |
| 756 | Image.DrawAlpha(FEngine.FSurface, r, GetDrawImageIndex, FAlpha) |
1379 | Writer.WriteBoolean(FAnimLooped); |
| 757 | end else |
1380 | end; |
| - | 1381 | ||
| - | 1382 | procedure TImageSprite.ReadAnimPos(Reader: TReader); |
|
| 758 | begin |
1383 | begin |
| 759 | Image.StretchDraw(FEngine.FSurface, r, GetDrawImageIndex); |
1384 | FAnimPos := Reader.ReadFloat; |
| 760 | end; |
1385 | end; |
| 761 | end else |
1386 | |
| - | 1387 | procedure TImageSprite.WriteAnimPos(Writer: TWriter); |
|
| 762 | begin |
1388 | begin |
| 763 | if FAlpha<255 then |
1389 | Writer.WriteFloat(FAnimPos); |
| - | 1390 | end; |
|
| - | 1391 | ||
| - | 1392 | procedure TImageSprite.ReadAnimSpeed(Reader: TReader); |
|
| 764 | begin |
1393 | begin |
| 765 | Image.DrawRotateAlpha(FEngine.FSurface, (r.Left+r.Right) div 2, (r.Top+r.Bottom) div 2, |
- | |
| 766 | Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle, FAlpha) |
1394 | FAnimSpeed := Reader.ReadFloat; |
| 767 | end else |
1395 | end; |
| - | 1396 | ||
| - | 1397 | procedure TImageSprite.WriteAnimSpeed(Writer: TWriter); |
|
| 768 | begin |
1398 | begin |
| 769 | Image.DrawRotate(FEngine.FSurface, (r.Left+r.Right) div 2, (r.Top+r.Bottom) div 2, |
- | |
| 770 | Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle) |
1399 | Writer.WriteFloat(FAnimSpeed); |
| 771 | end; |
1400 | end; |
| - | 1401 | ||
| - | 1402 | procedure TImageSprite.ReadAnimStart(Reader: TReader); |
|
| - | 1403 | begin |
|
| - | 1404 | FAnimStart := Reader.ReadInteger; |
|
| 772 | end; |
1405 | end; |
| - | 1406 | ||
| - | 1407 | procedure TImageSprite.WriteAnimStart(Writer: TWriter); |
|
| - | 1408 | begin |
|
| - | 1409 | Writer.WriteInteger(FAnimStart); |
|
| 773 | end; |
1410 | end; |
| 774 | 1411 | ||
| 775 | function TImageSpriteEx.GetBoundsRect: TRect; |
1412 | procedure TImageSprite.ReadPixelCheck(Reader: TReader); |
| 776 | begin |
1413 | begin |
| 777 | Result := FEngine.SurfaceRect; |
1414 | FPixelCheck := Reader.ReadBoolean; |
| 778 | end; |
1415 | end; |
| 779 | 1416 | ||
| 780 | function TImageSpriteEx.TestCollision(Sprite: TSprite): Boolean; |
1417 | procedure TImageSprite.WritePixelCheck(Writer: TWriter); |
| 781 | begin |
1418 | begin |
| 782 | if Sprite is TImageSpriteEx then |
1419 | Writer.WriteBoolean(FPixelCheck); |
| - | 1420 | end; |
|
| - | 1421 | ||
| - | 1422 | procedure TImageSprite.ReadTile(Reader: TReader); |
|
| 783 | begin |
1423 | begin |
| 784 | Result := OverlapRect(Bounds(Trunc(Sprite.WorldX), Trunc(Sprite.WorldY), Sprite.Width, Sprite.Height), |
- | |
| 785 | Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height)); |
1424 | FTile := Reader.ReadBoolean; |
| 786 | end else |
1425 | end; |
| - | 1426 | ||
| - | 1427 | procedure TImageSprite.WriteTile(Writer: TWriter); |
|
| 787 | begin |
1428 | begin |
| 788 | Result := OverlapRect(Sprite.BoundsRect, Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height)); |
1429 | Writer.WriteBoolean(FTile); |
| 789 | end; |
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; |
|
| 790 | end; |
1534 | end; |
| 791 | 1535 | ||
| 792 | { TBackgroundSprite } |
1536 | { TBackgroundSprite } |
| 793 | 1537 | ||
| 794 | constructor TBackgroundSprite.Create(AParent: TSprite); |
1538 | constructor TBackgroundSprite.Create(AParent: TSprite); |
| 795 | begin |
1539 | begin |
| 796 | inherited Create(AParent); |
1540 | inherited Create(AParent); |
| - | 1541 | FMap := nil; |
|
| - | 1542 | FMapWidth := 0; |
|
| - | 1543 | FMapHeight := 0; |
|
| 797 | Collisioned := False; |
1544 | Collisioned := False; |
| 798 | end; |
1545 | end; |
| 799 | 1546 | ||
| 800 | destructor TBackgroundSprite.Destroy; |
1547 | destructor TBackgroundSprite.Destroy; |
| 801 | begin |
1548 | begin |
| 802 | SetMapSize(0, 0); |
1549 | SetMapSize(0, 0); |
| 803 | inherited Destroy; |
1550 | inherited Destroy; |
| 804 | end; |
1551 | end; |
| 805 | 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 | ||
| 806 | procedure TBackgroundSprite.DoDraw; |
1569 | procedure TBackgroundSprite.DoDraw; |
| 807 | var |
1570 | var |
| 808 | _x, _y, cx, cy, cx2, cy2, c, ChipWidth, ChipHeight: Integer; |
1571 | TmpX, TmpY, cx, cy, cx2, cy2, PatternIndex, ChipWidth, ChipHeight: Integer; |
| 809 | StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer; |
1572 | StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer; |
| 810 | r: TRect; |
1573 | r: TRect; |
| - | 1574 | Q: TMapType; |
|
| 811 | begin |
1575 | begin |
| - | 1576 | LoadImage; |
|
| 812 | if Image=nil then Exit; |
1577 | if Image = nil then |
| - | 1578 | Exit; |
|
| 813 | 1579 | ||
| 814 | if (FMapWidth<=0) or (FMapHeight<=0) then Exit; |
1580 | if (FMapWidth <= 0) or (FMapHeight <= 0) then |
| - | 1581 | Exit; |
|
| 815 | 1582 | ||
| 816 | r := Image.PatternRects[0]; |
1583 | r := Image.PatternRects[0]; |
| 817 | ChipWidth := r.Right-r.Left; |
1584 | ChipWidth := r.Right - r.Left; |
| 818 | ChipHeight := r.Bottom-r.Top; |
1585 | ChipHeight := r.Bottom - r.Top; |
| 819 | 1586 | ||
| 820 | dWidth := (FEngine.SurfaceRect.Right+ChipWidth) div ChipWidth+1; |
1587 | dWidth := (FEngine.SurfaceRect.Right + ChipWidth) div ChipWidth + 1; |
| 821 | dHeight := (FEngine.SurfaceRect.Bottom+ChipHeight) div ChipHeight+1; |
1588 | dHeight := (FEngine.SurfaceRect.Bottom + ChipHeight) div ChipHeight + 1; |
| 822 | 1589 | ||
| 823 | _x := Trunc(WorldX); |
1590 | TmpX := Round(WorldX); |
| 824 | _y := Trunc(WorldY); |
1591 | TmpY := Round(WorldY); |
| 825 | 1592 | ||
| 826 | OfsX := _x mod ChipWidth; |
1593 | OfsX := TmpX mod ChipWidth; |
| 827 | OfsY := _y mod ChipHeight; |
1594 | OfsY := TmpY mod ChipHeight; |
| 828 | 1595 | ||
| 829 | StartX := _x div ChipWidth; |
1596 | StartX := TmpX div ChipWidth; |
| 830 | StartX_ := 0; |
1597 | StartX_ := 0; |
| 831 | 1598 | ||
| 832 | if StartX<0 then |
1599 | if StartX < 0 then |
| 833 | begin |
1600 | begin |
| 834 | StartX_ := -StartX; |
1601 | StartX_ := -StartX; |
| 835 | StartX := 0; |
1602 | StartX := 0; |
| 836 | end; |
1603 | end; |
| 837 | 1604 | ||
| 838 | StartY := _y div ChipHeight; |
1605 | StartY := TmpY div ChipHeight; |
| 839 | StartY_ := 0; |
1606 | StartY_ := 0; |
| 840 | 1607 | ||
| 841 | if StartY<0 then |
1608 | if StartY < 0 then |
| 842 | begin |
1609 | begin |
| 843 | StartY_ := -StartY; |
1610 | StartY_ := -StartY; |
| Line 853... | Line 1620... | ||
| 853 | begin |
1620 | begin |
| 854 | cy2 := Mod2((cy-StartY+StartY_), FMapHeight); |
1621 | cy2 := Mod2((cy - StartY + StartY_), FMapHeight); |
| 855 | for cx:=-1 to dWidth do |
1622 | for cx := -1 to dWidth do |
| 856 | begin |
1623 | begin |
| 857 | cx2 := Mod2((cx-StartX+StartX_), FMapWidth); |
1624 | cx2 := Mod2((cx - StartX + StartX_), FMapWidth); |
| 858 | c := Chips[cx2, cy2]; |
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 |
|
| 859 | if c>=0 then |
1636 | begin |
| - | 1637 | Q := Map[cx2,cy2]; |
|
| 860 | Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c); |
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); |
|
| 861 | end; |
1641 | end; |
| 862 | end; |
1642 | end; |
| - | 1643 | end; |
|
| - | 1644 | end; |
|
| - | 1645 | end; |
|
| - | 1646 | end |
|
| 863 | end else |
1647 | else |
| 864 | begin |
1648 | begin |
| 865 | for cy:=StartY to EndY-1 do |
1649 | for cy := StartY to EndY - 1 do |
| 866 | for cx:=StartX to EndX-1 do |
1650 | for cx := StartX to EndX - 1 do |
| 867 | begin |
1651 | begin |
| 868 | c := Chips[cx-StartX+StartX_, cy-StartY+StartY_]; |
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 |
|
| 869 | if c>=0 then |
1663 | begin |
| - | 1664 | Q := Map[cx,cy]; |
|
| 870 | Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c); |
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 |
|
| 871 | end; |
1671 | end; |
| 872 | end; |
1672 | end; |
| 873 | end; |
1673 | end; |
| 874 | 1674 | ||
| 875 | function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean; |
1675 | function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean; |
| 876 | var |
1676 | var |
| 877 | b, b1, b2: TRect; |
1677 | box0, box1, box2: TRect; |
| 878 | cx, cy, ChipWidth, ChipHeight: Integer; |
1678 | cx, cy, ChipWidth, ChipHeight: Integer; |
| 879 | r: TRect; |
1679 | r: TRect; |
| 880 | begin |
1680 | begin |
| 881 | Result := True; |
1681 | Result := True; |
| 882 | if Image=nil then Exit; |
1682 | if Image = nil then |
| - | 1683 | Exit; |
|
| 883 | if (FMapWidth<=0) or (FMapHeight<=0) then Exit; |
1684 | if (FMapWidth <= 0) or (FMapHeight <= 0) then |
| - | 1685 | Exit; |
|
| 884 | 1686 | ||
| 885 | r := Image.PatternRects[0]; |
1687 | r := Image.PatternRects[0]; |
| 886 | ChipWidth := r.Right-r.Left; |
1688 | ChipWidth := r.Right - r.Left; |
| 887 | ChipHeight := r.Bottom-r.Top; |
1689 | ChipHeight := r.Bottom - r.Top; |
| 888 | 1690 | ||
| - | 1691 | box1 := Sprite.BoundsRect; |
|
| - | 1692 | box2 := BoundsRect; |
|
| 889 | 1693 | ||
| - | 1694 | IntersectRect(box0, box1, box2); |
|
| 890 | 1695 | ||
| 891 | b1 := Sprite.BoundsRect; |
1696 | OffsetRect(box0, -Round(WorldX), -Round(WorldY)); |
| 892 | b2 := BoundsRect; |
- | |
| 893 | - | ||
| 894 | IntersectRect(b, b1, b2); |
1697 | OffsetRect(box1, -Round(WorldX), -Round(WorldY)); |
| 895 | 1698 | ||
| 896 | OffsetRect(b, -Trunc(WorldX), -Trunc(WorldY)); |
- | |
| 897 | OffsetRect(b1, -Trunc(WorldX), -Trunc(WorldY)); |
- | |
| 898 | - | ||
| 899 | for cy:=(b.Top-ChipHeight+1) div ChipHeight to b.Bottom div ChipHeight do |
1699 | for cy := (box0.Top - ChipHeight + 1) div ChipHeight to box0.Bottom div ChipHeight do |
| 900 | for cx:=(b.Left-ChipWidth+1) div ChipWidth to b.Right div ChipWidth do |
1700 | for cx := (box0.Left - ChipWidth + 1) div ChipWidth to box0.Right div ChipWidth do |
| 901 | if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then |
1701 | if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then |
| 902 | begin |
1702 | begin |
| 903 | if OverlapRect(Bounds(cx*ChipWidth, cy*ChipHeight, ChipWidth, ChipHeight), b1) then Exit; |
1703 | if OverlapRect(Bounds(cx * ChipWidth, cy * ChipHeight, ChipWidth, |
| - | 1704 | ChipHeight), box1) then |
|
| - | 1705 | Exit; |
|
| 904 | end; |
1706 | end; |
| 905 | 1707 | ||
| 906 | Result := False; |
1708 | Result := False; |
| 907 | end; |
1709 | end; |
| 908 | 1710 | ||
| 909 | function TBackgroundSprite.GetChip(X, Y: Integer): Integer; |
1711 | function TBackgroundSprite.GetChip(X, Y: Integer): Integer; |
| 910 | begin |
1712 | begin |
| 911 | if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then |
1713 | if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then |
| 912 | Result := PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^ |
1714 | Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.MapChip |
| 913 | else |
1715 | else |
| 914 | Result := -1; |
1716 | Result := -1; |
| 915 | end; |
1717 | end; |
| 916 | 1718 | ||
| 917 | type |
- | |
| 918 | PBoolean = ^Boolean; |
- | |
| 919 | - | ||
| 920 | function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean; |
1719 | function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean; |
| 921 | begin |
1720 | begin |
| 922 | if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then |
1721 | if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then |
| 923 | Result := PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^ |
1722 | Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionChip |
| 924 | else |
1723 | else |
| 925 | Result := False; |
1724 | Result := False; |
| 926 | end; |
1725 | end; |
| 927 | 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 | ||
| 928 | function TBackgroundSprite.GetBoundsRect: TRect; |
1751 | function TBackgroundSprite.GetBoundsRect: TRect; |
| 929 | begin |
1752 | begin |
| 930 | if FTile then |
1753 | if FTile then |
| 931 | Result := FEngine.SurfaceRect |
1754 | Result := FEngine.SurfaceRect |
| 932 | else |
1755 | else |
| 933 | begin |
1756 | begin |
| - | 1757 | LoadImage; |
|
| 934 | if Image<>nil then |
1758 | if Image <> nil then |
| 935 | Result := Bounds(Trunc(WorldX), Trunc(WorldY), |
1759 | Result := Bounds(Round(WorldX), Round(WorldY), Image.Width * FMapWidth, |
| 936 | Image.Width*FMapWidth, Image.Height*FMapHeight) |
1760 | Image.Height * FMapHeight) |
| 937 | else |
1761 | else |
| 938 | Result := Rect(0, 0, 0, 0); |
1762 | Result := Rect(0, 0, 0, 0); |
| 939 | end; |
1763 | end; |
| 940 | end; |
1764 | end; |
| 941 | 1765 | ||
| 942 | procedure TBackgroundSprite.SetChip(X, Y: Integer; Value: Integer); |
1766 | procedure TBackgroundSprite.SetChip(X, Y: Integer; Value: Integer); |
| 943 | begin |
1767 | begin |
| 944 | if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then |
1768 | if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then |
| 945 | PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^ := Value; |
1769 | PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.MapChip := Value; |
| 946 | end; |
1770 | end; |
| 947 | 1771 | ||
| 948 | procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean); |
1772 | procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean); |
| 949 | begin |
1773 | begin |
| 950 | if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then |
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 |
|
| 951 | PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^ := Value; |
1793 | PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^ := Value; |
| 952 | end; |
1794 | end; |
| 953 | 1795 | ||
| 954 | procedure TBackgroundSprite.SetMapHeight(Value: Integer); |
1796 | procedure TBackgroundSprite.SetMapHeight(Value: Integer); |
| 955 | begin |
1797 | begin |
| 956 | SetMapSize(FMapWidth, Value); |
1798 | SetMapSize(FMapWidth, Value); |
| Line 959... | Line 1801... | ||
| 959 | procedure TBackgroundSprite.SetMapWidth(Value: Integer); |
1801 | procedure TBackgroundSprite.SetMapWidth(Value: Integer); |
| 960 | begin |
1802 | begin |
| 961 | SetMapSize(Value, FMapHeight); |
1803 | SetMapSize(Value, FMapHeight); |
| 962 | end; |
1804 | end; |
| 963 | 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 | ||
| 964 | procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer); |
1821 | procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer); |
| - | 1822 | var I: Integer; |
|
| 965 | begin |
1823 | begin |
| 966 | if (FMapWidth<>AMapWidth) or (FMapHeight<>AMapHeight) then |
1824 | if (FMapWidth <> AMapWidth) or (FMapHeight <> AMapHeight) or (FMap = nil) then |
| 967 | begin |
1825 | begin |
| - | 1826 | try |
|
| 968 | if (AMapWidth<=0) or (AMapHeight<=0) then |
1827 | if (AMapWidth <= 0) or (AMapHeight <= 0) then |
| 969 | begin |
1828 | begin |
| - | 1829 | FreeMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType)); FMap := nil; |
|
| 970 | AMapWidth := 0; |
1830 | AMapWidth := 0; |
| 971 | AMapHeight := 0; |
1831 | AMapHeight := 0; |
| 972 | end; |
1832 | end; |
| 973 | FMapWidth := AMapWidth; |
1833 | FMapWidth := AMapWidth; |
| 974 | FMapHeight := AMapHeight; |
1834 | FMapHeight := AMapHeight; |
| 975 | ReAllocMem(FMap, FMapWidth*FMapHeight*SizeOf(Integer)); |
1835 | System.ReallocMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType)); |
| - | 1836 | if Assigned(FMap) then |
|
| - | 1837 | begin |
|
| 976 | FillChar(FMap^, FMapWidth*FMapHeight*SizeOf(Integer), 0); |
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; |
|
| 977 | 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); |
|
| 978 | ReAllocMem(FCollisionMap, FMapWidth*FMapHeight*SizeOf(Boolean)); |
1880 | if Assigned(FMap) and (Header.MapWidth > 0) and (Header.MapHeight > 0) then |
| - | 1881 | begin |
|
| 979 | FillChar(FCollisionMap^, FMapWidth*FMapHeight*SizeOf(Boolean), 1); |
1882 | Stream.ReadBuffer(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType)); |
| 980 | end; |
1883 | end; |
| 981 | end; |
1884 | end; |
| 982 | 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 | ||
| 983 | { TSpriteEngine } |
1916 | { TSpriteEngine } |
| 984 | 1917 | ||
| 985 | constructor TSpriteEngine.Create(AParent: TSprite); |
1918 | constructor TSpriteEngine.Create(AParent: TSprite); |
| 986 | begin |
1919 | begin |
| 987 | inherited Create(AParent); |
1920 | inherited Create(AParent); |
| 988 | FDeadList := TList.Create; |
1921 | FDeadList := TList.Create; |
| - | 1922 | // group handling |
|
| - | 1923 | {$IFDEF Ver4Up} |
|
| - | 1924 | fCurrentSelected := Tlist.create; |
|
| - | 1925 | GroupCount := 10; |
|
| - | 1926 | {$ENDIF} |
|
| 989 | end; |
1927 | end; |
| 990 | 1928 | ||
| 991 | destructor TSpriteEngine.Destroy; |
1929 | destructor TSpriteEngine.Destroy; |
| 992 | begin |
1930 | begin |
| - | 1931 | // cleanup Group handling |
|
| - | 1932 | {$IFDEF Ver4Up} |
|
| - | 1933 | ClearCurrent; |
|
| - | 1934 | GroupCount := 0; |
|
| - | 1935 | {$ENDIF} |
|
| 993 | FDeadList.Free; |
1936 | FDeadList.Free; |
| 994 | inherited Destroy; |
1937 | inherited Destroy; |
| - | 1938 | {$IFDEF Ver4Up} |
|
| - | 1939 | fCurrentSelected.free; |
|
| - | 1940 | {$ENDIF} |
|
| 995 | end; |
1941 | end; |
| 996 | 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 | ||
| 997 | procedure TSpriteEngine.Dead; |
2115 | procedure TSpriteEngine.Dead; |
| 998 | begin |
2116 | begin |
| 999 | while FDeadList.Count>0 do |
2117 | while FDeadList.Count > 0 do |
| 1000 | TSprite(FDeadList[FDeadList.Count-1]).Free; |
2118 | TSprite(FDeadList[FDeadList.Count - 1]).Free; |
| 1001 | end; |
2119 | end; |
| Line 1017... | Line 2135... | ||
| 1017 | end; |
2135 | end; |
| 1018 | end; |
2136 | end; |
| 1019 | 2137 | ||
| 1020 | { TCustomDXSpriteEngine } |
2138 | { TCustomDXSpriteEngine } |
| 1021 | 2139 | ||
| 1022 | constructor TCustomDXSpriteEngine.Create(AOnwer: TComponent); |
2140 | constructor TCustomDXSpriteEngine.Create(AOwner: TComponent); |
| 1023 | begin |
2141 | begin |
| 1024 | inherited Create(AOnwer); |
2142 | inherited Create(AOwner); |
| 1025 | FEngine := TSpriteEngine.Create(nil); |
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); |
|
| 1026 | end; |
2149 | end; |
| 1027 | 2150 | ||
| 1028 | destructor TCustomDXSpriteEngine.Destroy; |
2151 | destructor TCustomDXSpriteEngine.Destroy; |
| 1029 | begin |
2152 | begin |
| 1030 | FEngine.Free; |
2153 | FEngine.Free; |
| Line 1074... | Line 2197... | ||
| 1074 | 2197 | ||
| 1075 | if FDXDraw<>nil then |
2198 | if FDXDraw <> nil then |
| 1076 | FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent); |
2199 | FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent); |
| 1077 | end; |
2200 | end; |
| 1078 | 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 | ||