dxsprite.pas

传奇源代码的delphi版本

unit DXSprite;

interface

{$INCLUDE DelphiXcfg.inc}

uses
  Windows, SysUtils, Classes, DXClass, DXDraws,
{$IfDef StandardDX}
  DirectDraw;
{$Else}
  DirectX;
{$EndIf}


type
  {  BlendMode type  }
  
  TBlendMode = (bmDraw, bmBlend, bmAdd, bmSub);

  {  ESpriteError  }

  ESpriteError = class(Exception);

  {  TSprite  }

  TSpriteEngine = class;

  TSprite = class;
  TCollisionEvent = procedure(Sender: TObject; var Done: Boolean) of object;
  TMoveEvent = procedure(Sender: TObject; var MoveCount: Integer) of object;
  TDrawEvent = procedure(Sender: TObject) of object;
  TGetImage = procedure(Sender: TObject; var Image: TPictureCollectionItem) of object;

  TSprite = class(TPersistent)
  private
    FEngine: TSpriteEngine;
    FParent: TSprite;
    FList: TList;
    FDeaded: boolean;
    FDrawList: TList;
    FCollisioned: boolean;
    FMoved: boolean;
    FVisible: boolean;
    FX: double;
    FY: double;
    FZ: integer;
    FWidth: integer;
    FHeight: integer;
{$IFDEF Ver4Up}
    FSelected: boolean;
    FGroupNumber: integer;
{$ENDIF}
    FCaption: string;
    FTag: Integer;
    FOnDraw: TDrawEvent;
    FOnMove: TMoveEvent;
    FOnCollision: TCollisionEvent;
    FOnGetImage: TGetImage;
    procedure Add(Sprite: TSprite);
    procedure Remove(Sprite: TSprite);
    procedure AddDrawList(Sprite: TSprite);
    procedure Collision2;
    procedure Draw;
    function GetClientRect: TRect;
    function GetCount: integer;
    function GetItem(Index: integer): TSprite;
    function GetWorldX: double;
    function GetWorldY: double;
    procedure SetZ(Value: integer);
  protected
    procedure DoCollision(Sprite: TSprite; var Done: boolean); virtual;
    procedure DoDraw; virtual;
    procedure DoMove(MoveCount: integer); virtual;
    function GetBoundsRect: TRect; virtual;
    function TestCollision(Sprite: TSprite): boolean; virtual;
{$IFDEF Ver4Up}
    procedure SetGroupNumber(AGroupNumber: integer); virtual;
    procedure SetSelected(ASelected: Boolean); virtual;
{$ENDIF}
  public
    constructor Create(AParent: TSprite); virtual;
    destructor Destroy; override;
    procedure Clear;
    function Collision: integer;
    procedure Dead;
    procedure Move(MoveCount: integer);
    function GetSpriteAt(X, Y: integer): TSprite;
    property BoundsRect: TRect read GetBoundsRect;
    property ClientRect: TRect read GetClientRect;
    property Count: integer read GetCount;
    property Engine: TSpriteEngine read FEngine;
    property Items[Index: integer]: TSprite read GetItem; default;
    property Deaded: boolean read FDeaded;
    property Parent: TSprite read FParent;
    property WorldX: double read GetWorldX;
    property WorldY: double read GetWorldY;
    // Group handling support
{$IFDEF Ver4Up}
    // if GroupNumber < 0 then no group is assigned
    property GroupNumber: Integer read FGroupNumber write SetGroupNumber;
    property Selected: boolean read FSelected write SetSelected;
{$ENDIF}
    procedure Assign(Source: TPersistent); override;
  published
    property Height: integer read FHeight write FHeight;
    property Moved: boolean read FMoved write FMoved;
    property Visible: boolean read FVisible write FVisible;
    property Width: integer read FWidth write FWidth;
    property X: double read FX write FX;
    property Y: double read FY write FY;
    property Z: integer read FZ write SetZ;
    property Collisioned: boolean read FCollisioned write FCollisioned;
    property Tag: Integer read FTag write FTag;
    property Caption: string read FCaption write FCaption;
    property OnDraw: TDrawEvent read FOnDraw write FOnDraw;
    property OnMove: TMoveEvent read FOnMove write FOnMove;
    property OnCollision: TCollisionEvent read FOnCollision write FOnCollision;
    property OnGetImage: TGetImage read FOnGetImage write FOnGetImage;
  end;

  TSpriteClass = class of TSprite;

  {  TImageSprite  }

  TImageSprite = class(TSprite)
  private
    FAnimCount: integer;
    FAnimLooped: boolean;
    FAnimPos: double;
    FAnimSpeed: double;
    FAnimStart: integer;
    FImage: TPictureCollectionItem;
    FPixelCheck: boolean;
    FTile: boolean;
    FTransparent: boolean;
    function GetDrawImageIndex: integer;
    function GetDrawRect: TRect;
    function ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
      const rect1, rect2: TRect; x1, y1, x2, y2: integer;
      DoPixelCheck: boolean): boolean;
  protected
    procedure DoDraw; override;
    procedure DoMove(MoveCount: integer); override;
    function GetBoundsRect: TRect; override;
    function TestCollision(Sprite: TSprite): boolean; override;
    procedure SetImage(AImage: TPictureCollectionItem); virtual;
  public
    constructor Create(AParent: TSprite); override;
    procedure Assign(Source: TPersistent); override;
    procedure ReAnimate(MoveCount: integer);
    property Image: TPictureCollectionItem read FImage write SetImage;
  published
    property AnimCount: integer read FAnimCount write FAnimCount;
    property AnimLooped: boolean read FAnimLooped write FAnimLooped;
    property AnimPos: double read FAnimPos write FAnimPos;
    property AnimSpeed: double read FAnimSpeed write FAnimSpeed;
    property AnimStart: integer read FAnimStart write FAnimStart;
    property PixelCheck: boolean read FPixelCheck write FPixelCheck;
    property Tile: boolean read FTile write FTile;
    property OnDraw;
    property OnMove;
    property OnCollision;
    property OnGetImage;
  end;

  {  TImageSpriteEx  }

  TImageSpriteEx = class(TImageSprite)
  private
    FAngle: integer;
    FAlpha: integer;
    FBlendMode: TBlendMode;
  protected
    procedure DoDraw; override;
    function GetBoundsRect: TRect; override;
    function TestCollision(Sprite: TSprite): boolean; override;
  public
    constructor Create(AParent: TSprite); override;
    procedure Assign(Source: TPersistent); override;
  published
    property BlendMode: TBlendMode read FBlendMode write FBlendMode default bmDraw;
    property Angle: integer read FAngle write FAngle;
    property Alpha: integer read FAlpha write FAlpha;
    property AnimCount;
    property AnimLooped;
    property AnimPos;
    property AnimSpeed;
    property AnimStart;
    property PixelCheck;
    property Tile;
    property OnDraw;
    property OnMove;
    property OnCollision;
    property OnGetImage;
  end;

  {  TBackgroundSprite  }

  TBackgroundSprite = class(TSprite)
  private
    FImage: TPictureCollectionItem;
    FCollisionMap: Pointer;
    FMap: Pointer;
    FMapWidth: integer;
    FMapHeight: integer;
    FTile: boolean;
    FChipsRect: TRect;
    FChipsPatternIndex: Integer;
    function GetCollisionMapItem(X, Y: integer): boolean;
    function GetChip(X, Y: integer): integer;
    procedure SetChip(X, Y: integer; Value: integer);
    procedure SetCollisionMapItem(X, Y: integer; Value: boolean);
    procedure SetMapHeight(Value: integer);
    procedure SetMapWidth(Value: integer);
    procedure SetImage(Img: TPictureCollectionItem);
    procedure ChipsDraw(Image: TPictureCollectionItem; X, Y,
      PatternIndex: Integer);
  protected
    procedure DoDraw; override;
    function GetBoundsRect: TRect; override;
    function TestCollision(Sprite: TSprite): boolean; override;
  public
    constructor Create(AParent: TSprite); override;
    destructor Destroy; override;
    procedure SetMapSize(AMapWidth, AMapHeight: integer);
    property Chips[X, Y: integer]: integer read GetChip write SetChip;
    property CollisionMap[X, Y: integer]: boolean
    read GetCollisionMapItem write SetCollisionMapItem;
    procedure Assign(Source: TPersistent); override;
    Property ChipsRect: TRect read FChipsRect write FChipsRect;
    Property ChipsPatternIndex: Integer read FChipsPatternIndex write FChipsPatternIndex;
    property Image: TPictureCollectionItem read FImage write SetImage;
  published
    property MapHeight: integer read FMapHeight write SetMapHeight;
    property MapWidth: integer read FMapWidth write SetMapWidth;
    property Tile: boolean read FTile write FTile;
    property OnDraw;
    property OnMove;
    property OnCollision;
    property OnGetImage;
  end;

  {  TSpriteEngine  }

  TSpriteEngine = class(TSprite)
  private
    FAllCount: integer;
    FCollisionCount: integer;
    FCollisionDone: boolean;
    FCollisionRect: TRect;
    FCollisionSprite: TSprite;
    FDeadList: TList;
    FDrawCount: integer;
    FSurface: TDirectDrawSurface;
    FSurfaceRect: TRect;
{$IFDEF Ver4Up}
    FObjectsSelected: Boolean;
    FGroupCount: integer;
    FGroups: array of Tlist;
    FCurrentSelected: Tlist;
{$ENDIF}
  protected
    procedure SetSurface(Value: TDirectDrawSurface); virtual;
{$IFDEF Ver4Up}
    procedure SetGroupCount(AGroupCount: integer); virtual;
    function GetGroup(Index: integer): Tlist; virtual;
{$ENDIF}
  public
    constructor Create(AParent: TSprite); override;
    destructor Destroy; override;
    procedure Dead;
    procedure Draw;
    property AllCount: integer read FAllCount;
    property DrawCount: integer read FDrawCount;
    property Surface: TDirectDrawSurface read FSurface write SetSurface;
    property SurfaceRect: TRect read FSurfaceRect;

    // Extended Sprite Engine
    procedure Collisions;

    // Group handling support
{$IFDEF Ver4Up}
    procedure ClearCurrent;
    procedure ClearGroup(GroupNumber: integer);
    procedure GroupToCurrent(GroupNumber: integer; Add: Boolean = false);
    procedure CurrentToGroup(GroupNumber: integer; Add: Boolean = false);
    procedure GroupSelect(const Area: TRect; Filter: array of TSpriteClass; Add: Boolean = false); overload;
    procedure GroupSelect(const Area: TRect; Add: Boolean = false); overload;
    function Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = false): Tsprite; overload;
    function Select(Point: TPoint; Add: Boolean = false): Tsprite; overload;

    property CurrentSelected: TList read fCurrentSelected;
    property ObjectsSelected: Boolean read fObjectsSelected;
    property Groups[Index: integer]: Tlist read GetGroup;
    property GroupCount: integer read fGroupCount write SetGroupCount;
{$ENDIF}
  end;

  {  EDXSpriteEngineError  }

  EDXSpriteEngineError = class(Exception);

  TSpriteCollection = class;

  {  TSpriteType  }

  TSpriteType = (stSprite, stImageSprite, stImageSpriteEx, stBackgroundSprite);

  {  TSpriteCollectionItem  }

  TSpriteCollectionItem = class(THashCollectionItem)
  private
    FOwner: TPersistent;
    FOwnerItem: TSpriteEngine;
    FSpriteType: TSpriteType;
    FSprite: TSprite;
    procedure Finalize;
    procedure Initialize;
    function GetSpriteCollection: TSpriteCollection;
    procedure SetSprite(const Value: TSprite);
    procedure SetOnCollision(const Value: TCollisionEvent);
    procedure SetOnDraw(const Value: TDrawEvent);
    procedure SetOnMove(const Value: TMoveEvent);
    function GetSpriteType: TSpriteType;
    procedure SetSpriteType(const Value: TSpriteType);
    function GetOnCollision: TCollisionEvent;
    function GetOnDraw: TDrawEvent;
    function GetOnMove: TMoveEvent;
    function GetOnGetImage: TGetImage;
    procedure SetOnGetImage(const Value: TGetImage);
  protected
    function GetDisplayName: string; override;
    procedure SetDisplayName(const Value: string); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property SpriteCollection: TSpriteCollection read GetSpriteCollection;
  published
    {published property of sprite}
    property KindSprite: TSpriteType read GetSpriteType write SetSpriteType;
    property Sprite: TSprite read FSprite write SetSprite;
    {published events of sprite}
    property OnDraw: TDrawEvent read GetOnDraw write SetOnDraw;
    property OnMove: TMoveEvent read GetOnMove write SetOnMove;
    property OnCollision: TCollisionEvent read GetOnCollision write SetOnCollision;
    property OnGetImage: TGetImage read GetOnGetImage write SetOnGetImage;
  end;

  {  ESpriteCollectionError  }

  ESpriteCollectionError = class(Exception);

  {  TSpriteCollection  }

  TSCInitialize = procedure(Owner: TSpriteEngine) of object;
  TSCFinalize = procedure(Owner: TSpriteEngine) of object;

  TSpriteCollection = class(THashCollection)
  private
    FOwner: TPersistent;
    FOwnerItem: TSpriteEngine;
    FOnInitialize: TSCInitialize;
    FOnFinalize: TSCFinalize;
    function GetItem(Index: Integer): TSpriteCollectionItem;
    function Initialized: Boolean;
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    function Find(const Name: string): TSpriteCollectionItem;
    function Add: TSpriteCollectionItem;
    procedure Finalize;
    function Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
    property Items[Index: Integer]: TSpriteCollectionItem read GetItem; default;
  published
    property OnInitialize: TSCInitialize read FOnInitialize write FOnInitialize;
    property OnFinalize: TSCFinalize read FOnFinalize write FOnFinalize;
  end;

  {  TCustomDXSpriteEngine  }

  TCustomDXSpriteEngine = class(TComponent)
  private
    FDXDraw: TCustomDXDraw;
    FEngine: TSpriteEngine;
    FItems: TSpriteCollection;
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
    procedure SetDXDraw(Value: TCustomDXDraw);
    procedure SetItems(const Value: TSpriteCollection);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Dead;
    procedure Draw;
    procedure Move(MoveCount: integer);
    property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
    property Engine: TSpriteEngine read FEngine;
    property Items: TSpriteCollection read FItems write SetItems;
  end;

  {  TDXSpriteEngine  }

  TDXSpriteEngine = class(TCustomDXSpriteEngine)
    property Items;
  published
    property DXDraw;
  end;

function Mod2(i, i2: integer): integer;
function Mod2f(i: double; i2: integer): double;

implementation

uses DXConsts;

const
  SSpriteNotFound = 'Sprite not found';
  SSpriteDuplicateName = 'Item duplicate name "%s" error';

function Mod2(i, i2: integer): integer;
begin
  Result := i mod i2;
  if Result < 0 then
    Result := i2 + Result;
end;

function Mod2f(i: double; i2: integer): double;
begin
  if i2 = 0 then
    Result := i
  else
  begin
    Result := i - Round(i / i2) * i2;
    if Result < 0 then
      Result := i2 + Result;
  end;
end;

{  TSprite  }

constructor TSprite.Create(AParent: TSprite);
begin
  inherited Create;
{$IFDEF Ver4Up}
  fGroupnumber := -1;
{$ENDIF}
  FParent := AParent;
  if FParent <> nil then
  begin
    FParent.Add(Self);
    if FParent is TSpriteEngine then
      FEngine := TSpriteEngine(FParent)
    else
      FEngine := FParent.Engine;
    Inc(FEngine.FAllCount);
  end;

  FCollisioned := True;
  FMoved := True;
  FVisible := True;
end;

destructor TSprite.Destroy;
begin
{$IFDEF Ver4Up}
  GroupNumber := -1;
  Selected := false;
{$ENDIF}
  Clear;
  if FParent <> nil then
  begin
    Dec(FEngine.FAllCount);
    FParent.Remove(Self);
    FEngine.FDeadList.Remove(Self);
  end;
  FList.Free;
  FDrawList.Free;
  inherited Destroy;
end;