Subversion Repositories spacemission

Rev

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

  1. unit DXSprite;
  2.  
  3. interface
  4.                                    
  5. {$INCLUDE DelphiXcfg.inc}
  6.  
  7. uses
  8.   Windows, SysUtils, Classes, DXClass, DXDraws, DirectX;
  9.  
  10. type
  11.  
  12.   {  ESpriteError  }
  13.  
  14.   ESpriteError = class(Exception);
  15.  
  16.   {  TSprite  }
  17.  
  18.   TSpriteEngine = class;
  19.  
  20.   TSprite = class
  21.   private
  22.     FEngine: TSpriteEngine;
  23.     FParent: TSprite;
  24.     FList: TList;
  25.     FDeaded: Boolean;
  26.     FDrawList: TList;
  27.     FCollisioned: Boolean;
  28.     FMoved: Boolean;
  29.     FVisible: Boolean;
  30.     FX: Double;
  31.     FY: Double;
  32.     FZ: Integer;
  33.     FWidth: Integer;
  34.     FHeight: Integer;
  35.     procedure Add(Sprite: TSprite);
  36.     procedure Remove(Sprite: TSprite);
  37.     procedure AddDrawList(Sprite: TSprite);
  38.     procedure Collision2;
  39.     procedure Draw;
  40.     function GetClientRect: TRect;
  41.     function GetCount: Integer;
  42.     function GetItem(Index: Integer): TSprite;
  43.     function GetWorldX: Double;
  44.     function GetWorldY: Double;
  45.     procedure SetZ(Value: Integer);
  46.   protected
  47.     procedure DoCollision(Sprite: TSprite; var Done: Boolean); virtual;
  48.     procedure DoDraw; virtual;
  49.     procedure DoMove(MoveCount: Integer); virtual;
  50.     function GetBoundsRect: TRect; virtual;
  51.     function TestCollision(Sprite: TSprite): Boolean; virtual;
  52.   public
  53.     constructor Create(AParent: TSprite); virtual;
  54.     destructor Destroy; override;
  55.     procedure Clear;
  56.     function Collision: Integer;
  57.     procedure Dead;
  58.     procedure Move(MoveCount: Integer);
  59.     function GetSpriteAt(X, Y: Integer): TSprite;
  60.     property BoundsRect: TRect read GetBoundsRect;
  61.     property ClientRect: TRect read GetClientRect;
  62.     property Collisioned: Boolean read FCollisioned write FCollisioned;
  63.     property Count: Integer read GetCount;
  64.     property Engine: TSpriteEngine read FEngine;
  65.     property Items[Index: Integer]: TSprite read GetItem; default;
  66.     property Moved: Boolean read FMoved write FMoved;
  67.     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;
  71.     property WorldY: Double read GetWorldY;
  72.     property Height: Integer read FHeight write FHeight;
  73.     property X: Double read FX write FX;
  74.     property Y: Double read FY write FY;
  75.     property Z: Integer read FZ write SetZ;
  76.   end;
  77.  
  78.   {  TImageSprite  }
  79.  
  80.   TImageSprite = class(TSprite)
  81.   private
  82.     FAnimCount: Integer;
  83.     FAnimLooped: Boolean;
  84.     FAnimPos: Double;
  85.     FAnimSpeed: Double;
  86.     FAnimStart: Integer;
  87.     FImage: TPictureCollectionItem;
  88.     FPixelCheck: Boolean;
  89.     FTile: Boolean;
  90.     FTransparent: Boolean;
  91.     function GetDrawImageIndex: Integer;
  92.     function GetDrawRect: TRect;
  93.   protected
  94.     procedure DoDraw; override;
  95.     procedure DoMove(MoveCount: Integer); override;
  96.     function GetBoundsRect: TRect; override;
  97.     function TestCollision(Sprite: TSprite): Boolean; override;
  98.   public
  99.     constructor Create(AParent: TSprite); override;
  100.     property AnimCount: Integer read FAnimCount write FAnimCount;
  101.     property AnimLooped: Boolean read FAnimLooped write FAnimLooped;
  102.     property AnimPos: Double read FAnimPos write FAnimPos;
  103.     property AnimSpeed: Double read FAnimSpeed write FAnimSpeed;
  104.     property AnimStart: Integer read FAnimStart write FAnimStart;
  105.     property PixelCheck: Boolean read FPixelCheck write FPixelCheck;
  106.     property Image: TPictureCollectionItem read FImage write FImage;
  107.     property Tile: Boolean read FTile write FTile;
  108.   end;
  109.  
  110.   {  TImageSpriteEx  }
  111.  
  112.   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;
  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.                      
  126.   {  TBackgroundSprite  }
  127.  
  128.   TBackgroundSprite = class(TSprite)
  129.   private
  130.     FImage: TPictureCollectionItem;
  131.     FCollisionMap: Pointer;
  132.     FMap: Pointer;
  133.     FMapWidth: Integer;
  134.     FMapHeight: Integer;
  135.     FTile: Boolean;
  136.     function GetCollisionMapItem(X, Y: Integer): Boolean;
  137.     function GetChip(X, Y: Integer): Integer;
  138.     procedure SetChip(X, Y: Integer; Value: Integer);
  139.     procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean);
  140.     procedure SetMapHeight(Value: Integer);
  141.     procedure SetMapWidth(Value: Integer);
  142.   protected
  143.     procedure DoDraw; override;
  144.     function GetBoundsRect: TRect; override;
  145.     function TestCollision(Sprite: TSprite): Boolean; override;
  146.   public
  147.     constructor Create(AParent: TSprite); override;
  148.     destructor Destroy; override;
  149.     procedure SetMapSize(AMapWidth, AMapHeight: Integer);
  150.     property Chips[X, Y: Integer]: Integer read GetChip write SetChip;
  151.     property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem;
  152.     property Image: TPictureCollectionItem read FImage write FImage;
  153.     property MapHeight: Integer read FMapHeight write SetMapHeight;
  154.     property MapWidth: Integer read FMapWidth write SetMapWidth;
  155.     property Tile: Boolean read FTile write FTile;
  156.   end;
  157.  
  158.   {  TSpriteEngine  }
  159.  
  160.   TSpriteEngine = class(TSprite)
  161.   private
  162.     FAllCount: Integer;
  163.     FCollisionCount: Integer;
  164.     FCollisionDone: Boolean;
  165.     FCollisionRect: TRect;
  166.     FCollisionSprite: TSprite;
  167.     FDeadList: TList;
  168.     FDrawCount: Integer;
  169.     FSurface: TDirectDrawSurface;
  170.     FSurfaceRect: TRect;
  171.     procedure SetSurface(Value: TDirectDrawSurface);
  172.   public
  173.     constructor Create(AParent: TSprite); override;
  174.     destructor Destroy; override;
  175.     procedure Dead;
  176.     procedure Draw;
  177.     property AllCount: Integer read FAllCount;
  178.     property DrawCount: Integer read FDrawCount;
  179.     property Surface: TDirectDrawSurface read FSurface write SetSurface;
  180.     property SurfaceRect: TRect read FSurfaceRect;
  181.   end;
  182.  
  183.   {  EDXSpriteEngineError  }
  184.  
  185.   EDXSpriteEngineError = class(Exception);
  186.  
  187.   {  TCustomDXSpriteEngine  }
  188.  
  189.   TCustomDXSpriteEngine = class(TComponent)
  190.   private
  191.     FDXDraw: TCustomDXDraw;
  192.     FEngine: TSpriteEngine;
  193.     procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
  194.     procedure SetDXDraw(Value: TCustomDXDraw);
  195.   protected
  196.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  197.   public
  198.     constructor Create(AOnwer: TComponent); override;
  199.     destructor Destroy; override;
  200.     procedure Dead;
  201.     procedure Draw;
  202.     procedure Move(MoveCount: Integer);
  203.     property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
  204.     property Engine: TSpriteEngine read FEngine;                
  205.   end;
  206.  
  207.   {  TDXSpriteEngine  }
  208.  
  209.   TDXSpriteEngine = class(TCustomDXSpriteEngine)
  210.   published
  211.     property DXDraw;
  212.   end;
  213.  
  214. implementation
  215.  
  216. uses DXConsts;
  217.  
  218. function Mod2(i, i2: Integer): Integer;
  219. begin
  220.   Result := i mod i2;
  221.   if Result<0 then
  222.     Result := i2+Result;
  223. end;
  224.  
  225. function Mod2f(i: Double; i2: Integer): Double;
  226. begin
  227.   if i2=0 then
  228.     Result := i
  229.   else
  230.   begin
  231.     Result := i-Trunc(i/i2)*i2;
  232.     if Result<0 then
  233.       Result := i2+Result;
  234.   end;
  235. end;
  236.  
  237. {  TSprite  }
  238.  
  239. constructor TSprite.Create(AParent: TSprite);
  240. begin
  241.   inherited Create;
  242.   FParent := AParent;
  243.   if FParent<>nil then
  244.   begin
  245.     FParent.Add(Self);
  246.     if FParent is TSpriteEngine then
  247.       FEngine := TSpriteEngine(FParent)
  248.     else
  249.       FEngine := FParent.Engine;
  250.     Inc(FEngine.FAllCount);
  251.   end;
  252.  
  253.   FCollisioned := True;
  254.   FMoved := True;
  255.   FVisible := True;
  256. end;
  257.  
  258. destructor TSprite.Destroy;
  259. begin
  260.   Clear;
  261.   if FParent<>nil then
  262.   begin
  263.     Dec(FEngine.FAllCount);
  264.     FParent.Remove(Self);
  265.     FEngine.FDeadList.Remove(Self);
  266.   end;
  267.   FList.Free;
  268.   FDrawList.Free;
  269.   inherited Destroy;
  270. end;
  271.  
  272. procedure TSprite.Add(Sprite: TSprite);
  273. begin
  274.   if FList=nil then
  275.   begin
  276.     FList := TList.Create;
  277.     FDrawList := TList.Create;
  278.   end;
  279.   FList.Add(Sprite);
  280.   AddDrawList(Sprite);
  281. end;
  282.  
  283. procedure TSprite.Remove(Sprite: TSprite);
  284. begin
  285.   FList.Remove(Sprite);
  286.   FDrawList.Remove(Sprite);
  287.   if FList.Count=0 then
  288.   begin
  289.     FList.Free;
  290.     FList := nil;
  291.     FDrawList.Free;
  292.     FDrawList := nil;
  293.   end;
  294. end;
  295.  
  296. procedure TSprite.AddDrawList(Sprite: TSprite);
  297. var
  298.   L, H, I, C: Integer;
  299. begin
  300.   L := 0;
  301.   H := FDrawList.Count - 1;
  302.   while L <= H do
  303.   begin
  304.     I := (L + H) div 2;
  305.     C := TSprite(FDrawList[I]).Z-Sprite.Z;
  306.     if C < 0 then L := I + 1 else
  307.       H := I - 1;
  308.   end;
  309.   FDrawList.Insert(L, Sprite);
  310. end;
  311.  
  312. procedure TSprite.Clear;
  313. begin
  314.   while Count>0 do
  315.     Items[Count-1].Free;
  316. end;
  317.  
  318. function TSprite.Collision: Integer;
  319. var
  320.   i: Integer;
  321. begin
  322.   Result := 0;
  323.   if (FEngine<>nil) and (not FDeaded) and (Collisioned) then
  324.   begin
  325.     with FEngine do
  326.     begin
  327.       FCollisionCount := 0;
  328.       FCollisionDone := False;
  329.       FCollisionRect := Self.BoundsRect;
  330.       FCollisionSprite := Self;
  331.  
  332.       for i:=0 to Count-1 do
  333.         Items[i].Collision2;
  334.  
  335.       Result := FCollisionCount;
  336.     end;
  337.   end;
  338. end;
  339.  
  340. procedure TSprite.Collision2;
  341. var
  342.   i: Integer;
  343. begin
  344.   if Collisioned then
  345.   begin
  346.     if (Self<>FEngine.FCollisionSprite) and OverlapRect(BoundsRect, FEngine.FCollisionRect) and
  347.       FEngine.FCollisionSprite.TestCollision(Self) and TestCollision(FEngine.FCollisionSprite) then
  348.     begin
  349.       Inc(FEngine.FCollisionCount);
  350.       FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone);
  351.       if (not FEngine.FCollisionSprite.Collisioned) or (FEngine.FCollisionSprite.FDeaded) then
  352.       begin
  353.         FEngine.FCollisionDone := True;
  354.       end;
  355.     end;
  356.     if FEngine.FCollisionDone then Exit;
  357.     for i:=0 to Count-1 do
  358.       Items[i].Collision2;
  359.   end;
  360. end;
  361.  
  362. procedure TSprite.Dead;
  363. begin
  364.   if (FEngine<>nil) and (not FDeaded) then
  365.   begin
  366.     FDeaded := True;
  367.     FEngine.FDeadList.Add(Self);
  368.   end;
  369. end;
  370.  
  371. procedure TSprite.DoMove;
  372. begin
  373. end;
  374.  
  375. procedure TSprite.DoDraw;
  376. begin
  377. end;
  378.  
  379. procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
  380. begin
  381. end;
  382.  
  383. function TSprite.TestCollision(Sprite: TSprite): Boolean;
  384. begin
  385.   Result := True;
  386. end;
  387.  
  388. procedure TSprite.Move(MoveCount: Integer);
  389. var
  390.   i: Integer;
  391. begin
  392.   if FMoved then
  393.   begin
  394.     DoMove(MoveCount);
  395.     for i:=0 to Count-1 do
  396.       Items[i].Move(MoveCount);
  397.   end;
  398. end;
  399.  
  400. procedure TSprite.Draw;
  401. var
  402.   i: Integer;
  403. begin
  404.   if FVisible then
  405.   begin
  406.     if FEngine<>nil then
  407.     begin
  408.       if OverlapRect(FEngine.FSurfaceRect, BoundsRect) then
  409.       begin
  410.         DoDraw;
  411.         Inc(FEngine.FDrawCount);
  412.       end;
  413.     end;
  414.  
  415.     if FDrawList<>nil then
  416.     begin
  417.       for i:=0 to FDrawList.Count-1 do
  418.         TSprite(FDrawList[i]).Draw;
  419.     end;
  420.   end;
  421. end;
  422.  
  423. function TSprite.GetSpriteAt(X, Y: Integer): TSprite;
  424.  
  425.   procedure Collision_GetSpriteAt(X, Y: Double; Sprite: TSprite);
  426.   var
  427.     i: Integer;
  428.     X2, Y2: Double;
  429.   begin
  430.     if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)), Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Width)) then
  431.     begin
  432.       if (Result=nil) or (Sprite.Z>Result.Z) then
  433.         Result := Sprite;
  434.     end;
  435.  
  436.     X2 := X-Sprite.X;
  437.     Y2 := Y-Sprite.Y;
  438.     for i:=0 to Sprite.Count-1 do
  439.       Collision_GetSpriteAt(X2, Y2, Sprite.Items[i]);
  440.   end;
  441.  
  442. var
  443.   i: Integer;
  444.   X2, Y2: Double;
  445. begin
  446.   Result := nil;
  447.  
  448.   X2 := X-Self.X;
  449.   Y2 := Y-Self.Y;
  450.   for i:=0 to Count-1 do
  451.     Collision_GetSpriteAt(X2, Y2, Items[i]);
  452. end;                                    
  453.  
  454. function TSprite.GetBoundsRect: TRect;
  455. begin
  456.   Result := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height);
  457. end;
  458.  
  459. function TSprite.GetClientRect: TRect;
  460. begin
  461.   Result := Bounds(0, 0, Width, Height);
  462. end;
  463.  
  464. function TSprite.GetCount: Integer;
  465. begin
  466.   if FList<>nil then
  467.     Result := FList.Count
  468.   else
  469.     Result := 0;
  470. end;
  471.  
  472. function TSprite.GetItem(Index: Integer): TSprite;
  473. begin
  474.   if FList<>nil then
  475.     Result := FList[Index]
  476.   else
  477.     raise ESpriteError.CreateFmt(SListIndexError, [Index]);
  478. end;          
  479.  
  480. function TSprite.GetWorldX: Double;
  481. begin
  482.   if Parent<>nil then
  483.     Result := Parent.WorldX+FX
  484.   else
  485.     Result := FX;
  486. end;
  487.  
  488. function TSprite.GetWorldY: Double;
  489. begin
  490.   if Parent<>nil then
  491.     Result := Parent.WorldY+FY
  492.   else
  493.     Result := FY;
  494. end;
  495.  
  496. procedure TSprite.SetZ(Value: Integer);
  497. begin
  498.   if FZ<>Value then
  499.   begin
  500.     FZ := Value;
  501.     if Parent<>nil then
  502.     begin
  503.       Parent.FDrawList.Remove(Self);
  504.       Parent.AddDrawList(Self);
  505.     end;
  506.   end;
  507. end;
  508.  
  509. {  TImageSprite  }
  510.  
  511. constructor TImageSprite.Create(AParent: TSprite);
  512. begin
  513.   inherited Create(AParent);
  514.   FTransparent := True;
  515. end;
  516.  
  517. function TImageSprite.GetBoundsRect: TRect;
  518. var
  519.   dx, dy: Integer;
  520. begin
  521.   dx := Trunc(WorldX);
  522.   dy := Trunc(WorldY);
  523.   if FTile then
  524.   begin
  525.     dx := Mod2(dx, FEngine.SurfaceRect.Right+Width);
  526.     dy := Mod2(dy, FEngine.SurfaceRect.Bottom+Height);
  527.  
  528.     if dx>FEngine.SurfaceRect.Right then
  529.       dx := (dx-FEngine.SurfaceRect.Right)-Width;
  530.  
  531.     if dy>FEngine.SurfaceRect.Bottom then
  532.       dy := (dy-FEngine.SurfaceRect.Bottom)-Height;
  533.   end;
  534.  
  535.   Result := Bounds(dx, dy, Width, Height);
  536. end;
  537.  
  538. procedure TImageSprite.DoMove(MoveCount: Integer);
  539. begin
  540.   FAnimPos := FAnimPos + FAnimSpeed*MoveCount;
  541.  
  542.   if FAnimLooped then
  543.   begin
  544.     if FAnimCount>0 then
  545.       FAnimPos := Mod2f(FAnimPos, FAnimCount)
  546.     else
  547.       FAnimPos := 0;
  548.   end else
  549.   begin
  550.     if FAnimPos>=FAnimCount then
  551.     begin
  552.       FAnimPos := FAnimCount-1;
  553.       FAnimSpeed := 0;
  554.     end;
  555.     if FAnimPos<0 then
  556.     begin
  557.       FAnimPos := 0;
  558.       FAnimSpeed := 0;
  559.     end;
  560.   end;
  561. end;
  562.  
  563. function TImageSprite.GetDrawImageIndex: Integer;
  564. begin
  565.   Result := FAnimStart+Trunc(FAnimPos);
  566. end;
  567.  
  568. function TImageSprite.GetDrawRect: TRect;
  569. begin
  570.   Result := BoundsRect;
  571.   OffsetRect(Result, (Width-Image.Width) div 2, (Height-Image.Height) div 2);
  572. end;
  573.  
  574. procedure TImageSprite.DoDraw;
  575. var
  576.   ImageIndex: Integer;
  577.   r: TRect;
  578. begin
  579.   ImageIndex := GetDrawImageIndex;
  580.   r := GetDrawRect;
  581.   Image.Draw(FEngine.Surface, r.Left, r.Top, ImageIndex);
  582. end;
  583.  
  584. function ImageCollisionTest(suf1, suf2: TDirectDrawSurface; const rect1, rect2: TRect;
  585.   x1,y1,x2,y2: Integer; DoPixelCheck: Boolean): Boolean;
  586.  
  587.   function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
  588.   begin
  589.     with DestRect do
  590.     begin
  591.       Left := Max(Left, DestRect2.Left);
  592.       Right := Min(Right, DestRect2.Right);
  593.       Top := Max(Top, DestRect2.Top);
  594.       Bottom := Min(Bottom, DestRect2.Bottom);
  595.  
  596.       Result := (Left < Right) and (Top < Bottom);
  597.     end;
  598.   end;
  599.  
  600. type
  601.   PRGB = ^TRGB;
  602.   TRGB = packed record
  603.     R, G, B: Byte;
  604.   end;
  605. var
  606.   ddsd1, ddsd2: TDDSurfaceDesc;
  607.   r1, r2: TRect;
  608.   tc1, tc2: DWORD;
  609.   x, y, w, h: Integer;
  610.   P1, P2: Pointer;
  611. begin
  612.   r1 := rect1;
  613.   with rect2 do r2 := Bounds(x2-x1, y2-y1, Right-Left, Bottom-Top);
  614.  
  615.   Result := OverlapRect(r1, r2);
  616.  
  617.   if (suf1=nil) or (suf2=nil) then Exit;
  618.  
  619.   if DoPixelCheck and Result then
  620.   begin
  621.     {  Get Overlapping rectangle  }
  622.     with r1 do r1 := Bounds(Max(x2-x1, 0), Max(y2-y1, 0), Right-Left, Bottom-Top);
  623.     with r2 do r2 := Bounds(Max(x1-x2, 0), Max(y1-y2, 0), Right-Left, Bottom-Top);
  624.  
  625.     ClipRect(r1, rect1);
  626.     ClipRect(r2, rect2);
  627.  
  628.     w := Min(r1.Right-r1.Left, r2.Right-r2.Left);
  629.     h := Min(r1.Bottom-r1.Top, r2.Bottom-r2.Top);
  630.  
  631.     ClipRect(r1, bounds(r1.Left, r1.Top, w, h));
  632.     ClipRect(r2, bounds(r2.Left, r2.Top, w, h));
  633.                                
  634.     {  Pixel check !!!  }
  635.     ddsd1.dwSize := SizeOf(ddsd1);
  636.     if suf1.Lock(r1, ddsd1) then
  637.     begin
  638.       try
  639.         ddsd2.dwSize := SizeOf(ddsd2);
  640.         if (suf1=suf2) or suf2.Lock(r2, ddsd2) then
  641.         begin
  642.           try
  643.             if suf1=suf2 then ddsd2 := ddsd1;
  644.             if ddsd1.ddpfPixelFormat.dwRGBBitCount<>ddsd2.ddpfPixelFormat.dwRGBBitCount then Exit;
  645.                                      
  646.             {  Get transparent color  }
  647.             tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
  648.             tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;
  649.  
  650.             case ddsd1.ddpfPixelFormat.dwRGBBitCount of
  651.               8 : begin
  652.                     for y:=0 to h-1 do
  653.                     begin
  654.                       P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
  655.                       P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
  656.                       for x:=0 to w-1 do
  657.                       begin
  658.                         if (PByte(P1)^<>tc1) and (PByte(P2)^<>tc2) then Exit;
  659.                         Inc(PByte(P1));
  660.                         Inc(PByte(P2));
  661.                       end;
  662.                     end;
  663.                   end;
  664.               16: begin
  665.                     for y:=0 to h-1 do
  666.                     begin
  667.                       P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
  668.                       P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
  669.                       for x:=0 to w-1 do
  670.                       begin
  671.                         if (PWord(P1)^<>tc1) and (PWord(P2)^<>tc2) then Exit;
  672.                         Inc(PWord(P1));
  673.                         Inc(PWord(P2));
  674.                       end;
  675.                     end;
  676.                   end;
  677.               24: begin
  678.                     for y:=0 to h-1 do
  679.                     begin
  680.                       P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
  681.                       P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
  682.                       for x:=0 to w-1 do
  683.                       begin        
  684.                         if ((PRGB(P1)^.R shl 16) or (PRGB(P1)^.G shl 8) or PRGB(P1)^.B<>tc1) and
  685.                           ((PRGB(P2)^.R shl 16) or (PRGB(P2)^.G shl 8) or PRGB(P2)^.B<>tc2) then Exit;
  686.                         Inc(PRGB(P1));
  687.                         Inc(PRGB(P2));
  688.                       end;
  689.                     end;
  690.                   end;
  691.               32: begin
  692.                     for y:=0 to h-1 do
  693.                     begin
  694.                       P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
  695.                       P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
  696.                       for x:=0 to w-1 do
  697.                       begin
  698.                         if (PDWORD(P1)^ and $FFFFFF<>tc1) and (PDWORD(P2)^ and $FFFFFF<>tc2) then Exit;
  699.                         Inc(PDWORD(P1));
  700.                         Inc(PDWORD(P2));
  701.                       end;
  702.                     end;
  703.                   end;
  704.             end;
  705.           finally
  706.             if suf1<>suf2 then suf2.UnLock;
  707.           end;
  708.         end;
  709.       finally
  710.         suf1.UnLock;
  711.       end;
  712.     end;
  713.  
  714.     Result := False;
  715.   end;
  716. end;
  717.  
  718. function TImageSprite.TestCollision(Sprite: TSprite): Boolean;
  719. var
  720.   img1, img2: Integer;
  721.   b1, b2: TRect;
  722. begin
  723.   if (Sprite is TImageSprite) and FPixelCheck then
  724.   begin
  725.     b1 := GetDrawRect;
  726.     b2 := TImageSprite(Sprite).GetDrawRect;
  727.  
  728.     img1 := GetDrawImageIndex;
  729.     img2 := TImageSprite(Sprite).GetDrawImageIndex;
  730.  
  731.     Result := ImageCollisionTest(Image.PatternSurfaces[img1], TImageSprite(Sprite).Image.PatternSurfaces[img2],
  732.       Image.PatternRects[img1], TImageSprite(Sprite).Image.PatternRects[img2],
  733.       b1.Left, b1.Top, b2.Left, b2.Top, True);
  734.   end else
  735.     Result := inherited TestCollision(Sprite);
  736. end;
  737.  
  738. {  TImageSpriteEx  }
  739.  
  740. constructor TImageSpriteEx.Create(AParent: TSprite);
  741. begin
  742.   inherited Create(AParent);
  743.   FAlpha := 255;
  744. end;
  745.  
  746. procedure TImageSpriteEx.DoDraw;
  747. var
  748.   r: TRect;
  749. begin
  750.   r := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height);
  751.  
  752.   if FAngle and $FF=0 then
  753.   begin
  754.     if FAlpha<255 then
  755.     begin
  756.       Image.DrawAlpha(FEngine.FSurface, r, GetDrawImageIndex, FAlpha)
  757.     end else
  758.     begin
  759.       Image.StretchDraw(FEngine.FSurface, r, GetDrawImageIndex);
  760.     end;
  761.   end else
  762.   begin
  763.     if FAlpha<255 then
  764.     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)
  767.     end else
  768.     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)
  771.     end;
  772.   end;
  773. end;
  774.  
  775. function TImageSpriteEx.GetBoundsRect: TRect;
  776. begin
  777.   Result := FEngine.SurfaceRect;
  778. end;
  779.  
  780. function TImageSpriteEx.TestCollision(Sprite: TSprite): Boolean;
  781. begin
  782.   if Sprite is TImageSpriteEx then
  783.   begin
  784.     Result := OverlapRect(Bounds(Trunc(Sprite.WorldX), Trunc(Sprite.WorldY), Sprite.Width, Sprite.Height),
  785.       Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height));
  786.   end else
  787.   begin
  788.     Result := OverlapRect(Sprite.BoundsRect, Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height));
  789.   end;
  790. end;
  791.  
  792. {  TBackgroundSprite  }
  793.  
  794. constructor TBackgroundSprite.Create(AParent: TSprite);
  795. begin
  796.   inherited Create(AParent);
  797.   Collisioned := False;
  798. end;
  799.  
  800. destructor TBackgroundSprite.Destroy;
  801. begin
  802.   SetMapSize(0, 0);
  803.   inherited Destroy;
  804. end;
  805.  
  806. procedure TBackgroundSprite.DoDraw;
  807. var
  808.   _x, _y, cx, cy, cx2, cy2, c, ChipWidth, ChipHeight: Integer;
  809.   StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer;
  810.   r: TRect;
  811. begin
  812.   if Image=nil then Exit;
  813.  
  814.   if (FMapWidth<=0) or (FMapHeight<=0) then Exit;
  815.  
  816.   r := Image.PatternRects[0];
  817.   ChipWidth := r.Right-r.Left;
  818.   ChipHeight := r.Bottom-r.Top;
  819.  
  820.   dWidth := (FEngine.SurfaceRect.Right+ChipWidth) div ChipWidth+1;
  821.   dHeight := (FEngine.SurfaceRect.Bottom+ChipHeight) div ChipHeight+1;
  822.  
  823.   _x := Trunc(WorldX);
  824.   _y := Trunc(WorldY);
  825.  
  826.   OfsX := _x mod ChipWidth;
  827.   OfsY := _y mod ChipHeight;
  828.  
  829.   StartX := _x div ChipWidth;
  830.   StartX_ := 0;
  831.  
  832.   if StartX<0 then
  833.   begin
  834.     StartX_ := -StartX;
  835.     StartX := 0;
  836.   end;
  837.  
  838.   StartY := _y div ChipHeight;
  839.   StartY_ := 0;
  840.  
  841.   if StartY<0 then
  842.   begin
  843.     StartY_ := -StartY;
  844.     StartY := 0;
  845.   end;
  846.  
  847.   EndX := Min(StartX+FMapWidth-StartX_, dWidth);
  848.   EndY := Min(StartY+FMapHeight-StartY_, dHeight);
  849.  
  850.   if FTile then
  851.   begin
  852.     for cy:=-1 to dHeight do
  853.     begin
  854.       cy2 := Mod2((cy-StartY+StartY_), FMapHeight);
  855.       for cx:=-1 to dWidth do
  856.       begin
  857.         cx2 := Mod2((cx-StartX+StartX_), FMapWidth);
  858.         c := Chips[cx2, cy2];
  859.         if c>=0 then
  860.           Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c);
  861.       end;
  862.     end;
  863.   end else
  864.   begin
  865.     for cy:=StartY to EndY-1 do
  866.       for cx:=StartX to EndX-1 do
  867.       begin
  868.         c := Chips[cx-StartX+StartX_, cy-StartY+StartY_];
  869.         if c>=0 then
  870.           Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c);
  871.       end;
  872.   end;
  873. end;
  874.  
  875. function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean;
  876. var
  877.   b, b1, b2: TRect;
  878.   cx, cy, ChipWidth, ChipHeight: Integer;
  879.   r: TRect;
  880. begin
  881.   Result := True;
  882.   if Image=nil then Exit;
  883.   if (FMapWidth<=0) or (FMapHeight<=0) then Exit;
  884.  
  885.   r := Image.PatternRects[0];
  886.   ChipWidth := r.Right-r.Left;
  887.   ChipHeight := r.Bottom-r.Top;
  888.  
  889.  
  890.  
  891.   b1 := Sprite.BoundsRect;
  892.   b2 := BoundsRect;
  893.  
  894.   IntersectRect(b, b1, b2);
  895.  
  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
  900.     for cx:=(b.Left-ChipWidth+1) div ChipWidth to b.Right div ChipWidth do
  901.       if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then
  902.       begin
  903.         if OverlapRect(Bounds(cx*ChipWidth, cy*ChipHeight, ChipWidth, ChipHeight), b1) then Exit;
  904.       end;
  905.  
  906.   Result := False;
  907. end;
  908.  
  909. function TBackgroundSprite.GetChip(X, Y: Integer): Integer;
  910. begin
  911.   if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
  912.     Result := PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^
  913.   else
  914.     Result := -1;
  915. end;
  916.  
  917. type
  918.   PBoolean = ^Boolean;
  919.  
  920. function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean;
  921. begin
  922.   if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
  923.     Result := PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^
  924.   else
  925.     Result := False;
  926. end;
  927.  
  928. function TBackgroundSprite.GetBoundsRect: TRect;
  929. begin
  930.   if FTile then
  931.     Result := FEngine.SurfaceRect
  932.   else
  933.   begin
  934.     if Image<>nil then
  935.       Result := Bounds(Trunc(WorldX), Trunc(WorldY),
  936.         Image.Width*FMapWidth, Image.Height*FMapHeight)
  937.     else
  938.       Result := Rect(0, 0, 0, 0);
  939.   end;
  940. end;
  941.  
  942. procedure TBackgroundSprite.SetChip(X, Y: Integer; Value: Integer);
  943. begin
  944.   if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
  945.     PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^ := Value;
  946. end;
  947.  
  948. procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean);
  949. begin
  950.   if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
  951.     PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^ := Value;
  952. end;
  953.  
  954. procedure TBackgroundSprite.SetMapHeight(Value: Integer);
  955. begin
  956.   SetMapSize(FMapWidth, Value);
  957. end;
  958.  
  959. procedure TBackgroundSprite.SetMapWidth(Value: Integer);
  960. begin
  961.   SetMapSize(Value, FMapHeight);
  962. end;
  963.  
  964. procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer);
  965. begin
  966.   if (FMapWidth<>AMapWidth) or (FMapHeight<>AMapHeight) then
  967.   begin
  968.     if (AMapWidth<=0) or (AMapHeight<=0) then
  969.     begin
  970.       AMapWidth := 0;
  971.       AMapHeight := 0;
  972.     end;
  973.     FMapWidth := AMapWidth;
  974.     FMapHeight := AMapHeight;
  975.     ReAllocMem(FMap, FMapWidth*FMapHeight*SizeOf(Integer));
  976.     FillChar(FMap^, FMapWidth*FMapHeight*SizeOf(Integer), 0);
  977.  
  978.     ReAllocMem(FCollisionMap, FMapWidth*FMapHeight*SizeOf(Boolean));
  979.     FillChar(FCollisionMap^, FMapWidth*FMapHeight*SizeOf(Boolean), 1);
  980.   end;
  981. end;
  982.  
  983. {  TSpriteEngine  }
  984.  
  985. constructor TSpriteEngine.Create(AParent: TSprite);
  986. begin
  987.   inherited Create(AParent);
  988.   FDeadList := TList.Create;
  989. end;
  990.  
  991. destructor TSpriteEngine.Destroy;
  992. begin
  993.   FDeadList.Free;
  994.   inherited Destroy;
  995. end;
  996.  
  997. procedure TSpriteEngine.Dead;
  998. begin
  999.   while FDeadList.Count>0 do
  1000.     TSprite(FDeadList[FDeadList.Count-1]).Free;
  1001. end;
  1002.  
  1003. procedure TSpriteEngine.Draw;
  1004. begin
  1005.   FDrawCount := 0;
  1006.   inherited Draw;
  1007. end;
  1008.  
  1009. procedure TSpriteEngine.SetSurface(Value: TDirectDrawSurface);
  1010. begin
  1011.   FSurface := Value;
  1012.   if FSurface<>nil then
  1013.   begin
  1014.     FSurfaceRect := Surface.ClientRect;
  1015.     Width := FSurfaceRect.Right-FSurfaceRect.Left;
  1016.     Height := FSurfaceRect.Bottom-FSurfaceRect.Top;
  1017.   end;
  1018. end;
  1019.  
  1020. {  TCustomDXSpriteEngine  }
  1021.  
  1022. constructor TCustomDXSpriteEngine.Create(AOnwer: TComponent);
  1023. begin
  1024.   inherited Create(AOnwer);
  1025.   FEngine := TSpriteEngine.Create(nil);
  1026. end;
  1027.  
  1028. destructor TCustomDXSpriteEngine.Destroy;
  1029. begin                    
  1030.   FEngine.Free;
  1031.   inherited Destroy;
  1032. end;
  1033.  
  1034. procedure TCustomDXSpriteEngine.Notification(AComponent: TComponent;
  1035.   Operation: TOperation);
  1036. begin
  1037.   inherited Notification(AComponent, Operation);
  1038.   if (Operation=opRemove) and (DXDraw=AComponent) then
  1039.     DXDraw := nil;
  1040. end;
  1041.  
  1042. procedure TCustomDXSpriteEngine.Dead;
  1043. begin
  1044.   FEngine.Dead;
  1045. end;
  1046.  
  1047. procedure TCustomDXSpriteEngine.Draw;
  1048. begin
  1049.   if (FDXDraw<>nil) and (FDXDraw.Initialized) then
  1050.     FEngine.Draw;
  1051. end;
  1052.  
  1053. procedure TCustomDXSpriteEngine.Move(MoveCount: Integer);
  1054. begin
  1055.   FEngine.Move(MoveCount);
  1056. end;
  1057.  
  1058. procedure TCustomDXSpriteEngine.DXDrawNotifyEvent(Sender: TCustomDXDraw;
  1059.   NotifyType: TDXDrawNotifyType);
  1060. begin
  1061.   case NotifyType of
  1062.     dxntDestroying: DXDraw := nil;
  1063.     dxntInitialize: FEngine.Surface := Sender.Surface;
  1064.     dxntFinalize  : FEngine.Surface := nil;
  1065.   end;
  1066. end;
  1067.  
  1068. procedure TCustomDXSpriteEngine.SetDXDraw(Value: TCustomDXDraw);
  1069. begin
  1070.   if FDXDraw<>nil then
  1071.     FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
  1072.  
  1073.   FDXDraw := Value;
  1074.  
  1075.   if FDXDraw<>nil then
  1076.     FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
  1077. end;
  1078.  
  1079. end.
  1080.