usprite.~pas

泡泡游戏---实验阶段

unit USprite;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs,DXSprite,DXInput,DXDraws;

type
TPlayerStates=set of (sNormal,sTemp,sSparkling,sTrap,sDead);
TGameMap=Class;
  TGameSprite = class(TImageSpriteEx)
  private
    FActivateTime: Integer;
    FADX: Integer;
    FADY: Integer;
    FDXISL: TDXImageList;
    FGameMap: TGameMap;
    FQInActive: Integer;
    FQInPool: Integer;
    FSpriteName: string;
    function GetSX: Integer;
    function GetSY: Integer;
    procedure SetDXISL(Value: TDXImageList); virtual;
    procedure SetSX(Value: Integer);
    procedure SetSY(Value: Integer);
  public
    constructor Create(ASprite:TSprite); override;
    procedure Act; virtual; abstract;
    procedure Activate; virtual;
    function Clone: TGameSprite; virtual; abstract;
    procedure Dead;
    procedure DoMove(MoveCount:integer); override;
    function IsLinkWith(const oSprite:TGameSprite): Boolean; virtual;
    function MakeSelfDes: string; virtual;
    property ActivateTime: Integer read FActivateTime write FActivateTime;
    property ADX: Integer read FADX write FADX;
    property ADY: Integer read FADY write FADY;
    property DXISL: TDXImageList read FDXISL write SetDXISL;
    property GameMap: TGameMap read FGameMap write FGameMap;
    property QInActive: Integer read FQInActive write FQInActive;
    property QInPool: Integer read FQInPool write FQInPool;
    property SX: Integer read GetSX write SetSX;
    property SY: Integer read GetSY write SetSY;
  end;
  
  TPlayerSprite = class(TGameSprite)
  private
    FCurBombsSettled: Integer;
    FCurMaxBombs: Integer;
    FCurPower: Integer;
    FCurSpeed: Integer;
    FDXI: TDXInput;
    FIdledTime: Integer;
    FLastSettledTime: Integer;
    FMaxBombs: Integer;
    FMaxPower: Integer;
    FMaxSpeed: Integer;
    FPlayerNumber: Integer;
    FStates: TPlayerStates;
    FToDeadTimeSpan: Integer;
    FToSparkleTimeSpan: Integer;
    FTrapedTime: Integer;
    procedure ActNonePlayerInput;
    procedure ApplyGoods;
    procedure MoveDown;
    procedure MoveLeft;
    procedure MoveRight;
    procedure MoveUp;
    procedure SetDXISL(Value: TDXImageList); override;
  protected
    procedure DoCollision(Sprite: TSprite; var Done: Boolean); override;
    procedure SwitchToState(const sState:TPlayerStates);
  public
    constructor Create(ASprite:TSprite); override;
    procedure Act; override;
    procedure Activate; override;
    function Clone: TGameSprite; override;
    procedure DoMove(MoveCount:integer); override;
    procedure ResetIdledTime;
    procedure ResetTrapedTime;
    procedure SettleBomb;
    procedure SubCurBombsSettled;
    procedure Trap;
    procedure UnTrap;
    property DXI: TDXInput read FDXI write FDXI;
    property PlayerNumber: Integer read FPlayerNumber write FPlayerNumber;
    property States: TPlayerStates read FStates;
  end;
  
  TBombSprite = class(TGameSprite)
  private
    FPlayer: TPlayerSprite;
    FPower: Integer;
    FTimeSpanToExplode: Integer;
    procedure Explode;
    procedure SetDXISL(Value: TDXImageList); override;
  public
    constructor Create(ASprite:TSprite); override;
    procedure Act; override;
    procedure Activate; override;
    function Clone: TGameSprite; override;
    procedure Dead;
    procedure DoMove(MoveCount:integer); override;
    procedure Init(const iExtendPower,iSX,iSY:integer);
    function IsLinkWith(const oSprite:TGameSprite): Boolean; override;
    function MakeSelfDes: string; override;
    property Player: TPlayerSprite read FPlayer write FPlayer;
    property Power: Integer read FPower write FPower;
    property TimeSpanToExplode: Integer read FTimeSpanToExplode;
  end;
  
  TFireSprite = class(TGameSprite)
  private
    FExtended: Boolean;
    FExtendPower: Integer;
    FExtendTimeSpan: Integer;
  public
    procedure Act; override;
    function Clone: TGameSprite; override;
    procedure Dead;
    procedure Extend; virtual;
    function MakeSelfDes: string; override;
    property ExtendPower: Integer read FExtendPower;
  end;
  
  TCenterFireSprite = class(TFireSprite)
  private
    procedure SetDXISL(Value: TDXImageList); override;
  public
    constructor Create(ASprite:TSprite); override;
    function Clone: TGameSprite; override;
    procedure Extend; override;
    procedure Init(const iExtendPower:integer;iSX,iSY:integer);
    function MakeSelfDes: string; override;
  end;
  
  TExtendFireSprite = class(TFireSprite)
  private
    FDirection: Integer;
    procedure SetDXISL(Value: TDXImageList); override;
  public
    constructor Create(ASprite:TSprite); override;
    function Clone: TGameSprite; override;
    procedure Extend; override;
    procedure Init(const iExtendPower,iDrection:integer;iSX,iSY:integer);
    function MakeSelfDes: string; override;
    property Direction: Integer read FDirection;
  end;
  
  TPos = packed record
    X: Integer;
    Y: Integer;
  end;
  
  TGameMap = class(TObject)
  private
    FHeight: Integer;
    FLeft: Integer;
    FSpriteAtXY: array of array of TGameSprite;
    FTileSize: Integer;
    FTop: Integer;
    FWidth: Integer;
    FXTiles: Integer;
    FYTiles: Integer;
    procedure SetTileSize(Value: Integer);
  public
    constructor Create;
    procedure ClearSpriteAt(const iSX,iSY:integer);
    function GetBombAt(const iSX,iSY:integer): TBombSprite;
    function MapPos(const Pos:TPos): TPos;
    function SetSpriteAt(const iSX,iSY:integer;const oSprite:TGameSprite):
            Boolean;
    procedure SetXYTiles(const iXTiles,iYTiles:integer);
    function UnMapPos(const Pos:TPos): TPos;
    property Height: Integer read FHeight;
    property Left: Integer read FLeft write FLeft;
    property TileSize: Integer read FTileSize write SetTileSize;
    property Top: Integer read FTop write FTop;
    property Width: Integer read FWidth;
    property XTiles: Integer read FXTiles;
    property YTiles: Integer read FYTiles;
  end;
  
  TSpriteItem = record
    Next: Integer;
    Sprite: TGameSprite;
  end;
  
  TUseDes = record
    ClassID: string;
    Count: Integer;
    HeadIndex: Integer;
    UsedCount: Integer;
  end;
  
  TActiveSpriteLinkNode = record
    Next: Integer;
    Prior: Integer;
    Sprite: TGameSprite;
  end;
  
  TActiveSpriteManager = class(TObject)
  private
    FCapacity: Integer;
    FFreeHeadIndex: Integer;
    FLinkNum: Integer;
    FSpriteLink: array of TActiveSpriteLinkNode;
    FTmpList: TList;
    FUsedCount: Integer;
    FUsedHeadIndex: Integer;
    FUsedRearIndex: Integer;
  protected
    function LinkExplodeProccess(const oBombQInActive:integer): Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function AddSprite(const oSprite:TGameSprite): Boolean;
    procedure DoAct;
    procedure MakeSpace(const iSpace:integer);
    procedure ReleaseSprite(const oSprite:TGameSprite);
    property Capacity: Integer read FCapacity;
    property LinkNum: Integer read FLinkNum write FLinkNum;
    property UsedCount: Integer read FUsedCount;
  end;
  
  TGameSpritePool = class(TObject)
  private
    FClassCount: Integer;
    FSpriteCount: Integer;
    FSpriteItems: array of TSpriteItem;
    FUseDesList: array of TUseDes;
    function FindOutUseDes(const strClassID:string): Integer;
  public
    destructor Destroy; override;
    function GetSprite(const strClassID:string): TGameSprite;
    procedure ResisterSprite(const oSprite: TGameSprite;const iAmount:integer);
    procedure ReturnSprite(const oSprite: TGameSprite);
    property ClassCount: Integer read FClassCount;
    property SpriteCount: Integer read FSpriteCount;
  end;
  
  TASMSingleton = class(TObject)
  public
    class procedure FreeASM;
    class function GetASM: TActiveSpriteManager;
  end;
  
  TPoolSingleton = class(TObject)
  public
    class procedure FreePool;
    class function GetSpritePool: TGameSpritePool;
  end;
  

var g_oASM:TActiveSpriteManager;
    g_oSpritePool:TGameSpritePool;
implementation

{
********************************* TGameSprite **********************************
}
constructor TGameSprite.Create(ASprite:TSprite);
begin
  inherited Create(ASprite);
  if Assigned(Parent) then
  begin
    Parent.Remove(self);//从动画引擎中去除
  end;
  //因为DelphiX中的精灵一创建就要加入加入动画引擎中，进行动画处理。
  //但这里，因为要使用对象池，所以精灵并不是在创建后就要用动画引
  //擎进行处理。而是在激活该精灵对象后，也就是进入了活动精灵管理中时
  //才进行动画处理的。
  //另外，我将DelphiX中的Sprite类的Remove方法与Add方法的访问权限
  //改成了Public。所以，要使该源码能顺利编译，请修改您自己的Delphix中
  //的Sprite类。
end;

procedure TGameSprite.Activate;
begin
  FActivateTime:=GetTickCount();//取得激活时间点
  (TASMSingleton.GetASM()).AddSprite(self);//加入活动精灵组中
  Parent.Add(self);//加入到动画引擎中进行处理
end;

procedure TGameSprite.Dead;
begin
  inherited Dead;
  FActivateTime:=-1;
  Parent.Remove(self);
  (TASMSingleton.GetASM()).ReleaseSprite(self);//从活动精灵管理中去掉
  
  (TPoolSingleton.GetSpritePool()).ReturnSprite(self);//释放回对象池;
end;

procedure TGameSprite.DoMove(MoveCount:integer);
begin
  inherited DoMove(MoveCount);
end;

function TGameSprite.GetSX: Integer;
begin
  Result:=Round((X+ADX)/GameMap.TileSize);
end;

function TGameSprite.GetSY: Integer;
begin
  Result:=Round((Y+ADY)/GameMap.TileSize);
end;

function TGameSprite.IsLinkWith(const oSprite:TGameSprite): Boolean;
begin
  Result:=False;
  if ((oSprite.SX=SX) or(oSprite.SY=SY))then
  begin
   Result:=True;
   Exit;
  end;
end;

function TGameSprite.MakeSelfDes: string;
begin
  if FActivateTime<0 then
  begin
   Result:=FSpriteName+'对象池中的位序:'+IntToStr(FQInPool);
  end;
end;

procedure TGameSprite.SetDXISL(Value: TDXImageList);
begin
  FDXISL:=Value;
end;

procedure TGameSprite.SetSX(Value: Integer);
begin
  X:=Value*GameMap.TileSize-ADX;
end;

procedure TGameSprite.SetSY(Value: Integer);
begin
  Y:=Value*GameMap.TileSize-ADY;
end;

{
******************************** TPlayerSprite *********************************
}
constructor TPlayerSprite.Create(ASprite:TSprite);
begin
  inherited Create(ASprite);
  FIdledTime:=-1;
  FCurSpeed:=5;
  FTOSparkleTimeSpan:=3000;
  
  FStates:=FStates+[sNormal];
  FCurPower:=8;
  FCurMaxBombs:=50;
  FSpriteName:='玩家-宝宝';
end;

procedure TPlayerSprite.Act;
var
  bActed: Boolean;
begin
  bActed:=False;
  DXI.Update;
  
  
    if sDead in FStates then//若处于死状态
     begin
     end else//
     if sTrap in FStates then//叵处于被水柱冻住的状态
     begin
           if ((FPlayerNumber=0)and(DXI.KeyBoard.Keys[Ord('/')]))or
              ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('S')]))
           then //使用道具
           begin
            ApplyGoods;
            bActed:=True;
            //ResetIdledTime;
           end;
     end else
    if (sNormal in FStates) or
       (sSparkling in FStates) or
       (sTemp in FStates) then//若处于一般、眨眼、临时状态
    begin
    if ((FPlayerNumber=0) and (DXI.KeyBoard.Keys[Ord('.')]))or
       ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('A')]))
    then //使用道具
     begin
      ApplyGoods;
      bActed:=True;
      //ResetIdledTime;
     end;
     if ((FPlayerNumber=0)and(isRight in DXI.States))or
        ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('H')]))
      then
     begin
       MoveRight;
       bActed:=True;
     end else
     if ((FPlayerNumber=0)and(isLeft in DXI.States))or
        ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('F')]))
       then
     begin
       MoveLeft;
       bActed:=True;
     end else
     if ((FPlayerNumber=0)and(isDown in DXI.States))or
        ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('G')]))
     then
     begin
       MoveDown;
       bActed:=True;
     end else
     if ((FPlayerNumber=0)and(isUp in DXI.States))or
        ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('T')]))
     then
     begin
       MoveUp;
       bActed:=True;
     end;
     if ((FPlayerNumber=0)and(DXI.KeyBoard.Keys[Ord('/')]))or
        ((FPlayerNumber=1) and (DXI.KeyBoard.Keys[Ord('S')]))
     then
     begin
     if GetTickCount()>=Cardinal(FLastSettledTime+100) then
     begin
      SettleBomb;//放雷
      FLastSettledTime:=GetTickCount();
     end;
     bActed:=True;
     end;
   end;//endsNorml..
  
  
  if not bActed then
  begin
   ActNonePlayerInput;
  end;
  
  
  
  
  
  
  
  //////////////////////////////////
end;

procedure TPlayerSprite.Activate;
begin
  FActivateTime:=GetTickCount();//取得激活时间点
  Parent.Add(self);
end;

procedure TPlayerSprite.ActNonePlayerInput;
begin
  if not (FIdledTime>0) then
  begin
    FIdledTime:=GetTickCount();
    Exit;
  end;
  if GetTickCount>=Cardinal(FIdledTime+FToSparkleTimeSpan) then
  begin
    if not ((sSparkling in FStates)and(sTemp in FStates)) then
    SwitchToState([sSparkling]);
    ResetIdledTime;
    Exit;
  end;
  if not (sSparkling in FStates) then
  begin