hgespriteengine.pas

完整的Delphi游戏开发控件

     property FallingSpeed: single read FFallingSpeed write FFallingSpeed;
     property HoldKey: Boolean read FHoldKey write FHoldKey;
     property JumpCount: Integer read FJumpCount write FJumpCount;
     property JumpState: TJumpState read FJumpState write SetJumpState;
     property JumpSpeed: Single read FJumpSpeed write FJumpSpeed;
     property JumpHeight: Single read FJumpHeight write FJumpHeight;
     property MaxFallSpeed: Single read FMaxFallSpeed write FMaxFallSpeed;
     property DoJump: Boolean read  FDoJump write FDoJump;
 end;

 TTileMapSprite = class(TSpriteEx)
 private
      FCollisionMap: Pointer;
      FMap: Pointer;
      FMapW:Integer;
      FMapH: Integer;
      FMapWidth: Integer;
      FMapHeight: Integer;
      FDoTile: Boolean;
      function GetCollisionMapItem(X, Y: Integer): Boolean;
      function GetCell(X, Y: Integer): Integer;
      procedure Draw; override;
      procedure SetCell(X, Y: Integer; Value: Integer);
      procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean);
      procedure SetMapHeight(Value: Integer);
      procedure SetMapWidth(Value: Integer);
 protected
      function GetBoundsRect: TRect; override;
      function TestCollision(Sprite: TSprite): Boolean;
 public
      constructor Create(const AParent: TSprite); override;
      destructor Destroy; override;
      procedure DoDraw; override;
      property BoundsRect: TRect read GetBoundsRect;
      procedure SetMapSize(AMapWidth, AMapHeight: Integer);
      property Cells[X, Y: Integer]: Integer read GetCell write SetCell;
      property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem;
      property MapHeight: Integer read FMapHeight write SetMapHeight;
      property MapWidth: Integer read FMapWidth write SetMapWidth;
      property DoTile: Boolean read FDoTile write FDoTile;
 end;
 TContainer = array[0..20, 0..50] of TRect;

 TGUISprite = class(TAnimatedSprite)
 private
      FOwner: TGUISprite;
      FEnabled: Boolean;
      FGUIType: TGUIType;
      FHighLight: Boolean;
      FCaption: string;
      FShowHint: Boolean;
      FHintString: string;
      FCanDrag: Boolean;
      FCanFlip: Boolean;
      FPickUp: Boolean;
      FCanPickUp: Boolean;
      FUseContainer: Boolean;
      FZList: TList;
      FMouseOffsetX, FMouseOffsetY: Integer;
      FIsMouseDown: Boolean;
      FClicked : Boolean;
 public
      Container : TContainer;// read FContainer write FContainer;
      constructor Create(const AParent: TSprite); override;
      destructor Destroy; override;
      procedure DoMove(const MoveCount: Single); override;
      procedure OnLMouseUp; override;
      procedure OnLMouseDown; override;
      procedure OnMouseMove; override;
      procedure OnMouseEnter; override;
      procedure OnMouseLeave; override;
      procedure OnMouseDrag; override;
      property GuiType: TGuiType read FGuiType write FGuiType;
      property Enabled: Boolean read FEnabled write FEnabled;
      property HighLight: Boolean read FHighLight write FHighLight;
      property ShowHint: Boolean read FShowHint write FShowHint;
      property HintString: string read FHintString write FHintString;
      property CanDrag: Boolean read FCanDrag write FCanDrag;
      property CanFlip: Boolean read FCanFlip write FCanFlip;
      property CanPickUp: Boolean read FCanPickUp write FCanPickUp;
      property UseContainer: Boolean read FUseContainer write FUseContainer;
      property Caption: string read FCaption write FCaption;
      property Owner: TGUISprite read FOwner write FOwner;
 end;

 TPathSprite = class(TAnimatedSprite)
 private
      FLooped: Boolean;
      FSegment: Integer;
      FDistance: Single;
      FPosition: TPoint;
      FMoveSpeed: Single;
      function Calculate(P0, P1, P2, P3: Integer; T: Single): Integer;
      function CalculatePoint(CP0, CP1, CP2, CP3: TPoint; T: Single): TPoint;
      function GetPosition: TPoint;
      function GetSegment: Integer;
      procedure SetSegment(const Value: Integer);
      procedure SetLooped(const Value: Boolean);
      procedure SetDistance(const Value: Single);
 public
      FCtrlPts: array of TPoint;
      function GetPoint(Index: Integer): TPoint;
      constructor Create(const AParent: TSprite); override;
      procedure DoMove(const MoveCount: Single); override;
      destructor Destroy; override;
      procedure AddPoint(X, Y: Integer); overload;
      procedure AddPoint(Point: TPoint); overload;
      property Looped: Boolean read FLooped write SetLooped;
      property Segment: Integer read GetSegment write SetSegment;
      property Distance: Single read FDistance write SetDistance;
      property Position: TPoint read GetPosition;
      property MoveSpeed: Single read FMoveSpeed write FMoveSpeed; 
 end;

 TNPathSprite = class(TAnimatedSprite)
 private
      FPath: TNURBSCurveEx;
      FDistance: Single;  // [0,100]
      FPosition: TPoint2;
      FMoveSpeed: Single;
      FAccel: Single;
      FUpdateSpeed : Single;
      FMaxParameter: Integer;
      function GetPosition: TPoint2;
      procedure SetDistance(const Value: Single);
 public
      property Path: TNURBSCurveEx read FPath write FPath;
      procedure DoMove(const MoveCount: Single); override;
      procedure LookAt(anAngle: Single);
      property Distance: Single read FDistance write SetDistance;
      property Position: TPoint2 read GetPosition;
      property MoveSpeed: Single read FMoveSpeed write FMoveSpeed;
      property Accel: Single read FAccel write FAccel;
      property UpdateSpeed : Single read FUpdateSpeed write FUpdateSpeed;
      property MaxParameter: Integer read FMaxParameter write FMaxParameter;
      constructor Create(const AParent: TSprite); override;
      destructor Destroy; override;
 end;

 TSpriteEngine = class(TSprite)
 private
      FAllCount: Integer;
      FDeadList: TList;
      FDrawCount: Integer;
      FWorldX, FWorldY: Single;
      FObjectsSelected : Boolean;
      FGroupCount: Integer;
      FGroups:array of TList;
      FCurrentSelected : TList;
      FVisibleWidth: Integer;
      FVisibleHeight: Integer;
      FDoMouseEvent: Boolean;
      FZCounter: Integer;
      FImages: THGEImages;
      FCanvas: THGECanvas;
 protected
      procedure SetGroupCount(AGroupCount: Integer); virtual;
      function GetGroup(Index: Integer): TList; virtual;
 public
      constructor Create(const AParent: TSprite); override;
      destructor Destroy; override;
      procedure Draw; override;
      procedure Dead;
      function Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = False): TSprite; overload;
      function Select(Point: TPoint; Add: Boolean = False): TSprite; overload;
      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;
      property AllCount: Integer read FAllCount;
      property DrawCount: Integer read FDrawCount;
      property VisibleWidth:Integer read FVisibleWidth write FVisibleWidth;
      property VisibleHeight: Integer read FVisibleHeight write FVisibleHeight;
      property WorldX: Single read FWorldX write FWorldX;
      property WorldY: Single read FWorldY write FWorldY;
      property CurrentSelected: TList  read FCurrentSelected;
      property ObjectsSelected: Boolean read FObjectsSelected;
      property Groups[index: Integer]: TList read GetGroup;
      property GroupCount: Integer read FGroupCount write SetGroupCount;
      property Images: THGEImages read FImages write FImages;
      property Canvas: THGECanvas read FCanvas write FCanvas;
 end;

procedure GetMouseEvent;

implementation

var
  FHGE: IHGE = nil;
  Event:THGEInputEvent;
  MouseX, MouseY: Single;

procedure GetMouseEvent;
begin
  FHge.Input_GetMousePos(MouseX, MouseY);
  FHGE.Input_GetEvent(Event);
end;

  {  TSprite }
constructor TSprite.Create(const AParent: TSprite);
begin
     inherited Create;
     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;
     FX := 200;
     FY := 200;
     FZ := 0;
     if Z = 0 then Z := 1;
     FWidth := 64;
     FHeight:= 64;
     FName := '';
     FZ := 0;
     FPatternIndex := 0;
     FDoCollision := False;
     FMoved := True;
     FBlendMode := Blend_Default;
     FVisible := True;
     TruncMove := True;
     FTag := 0;
end;

destructor TSprite.Destroy;
begin
     Clear;
     if FParent <> nil then
     begin
          Dec(FEngine.FAllCount);
          FParent.Remove(Self);
          FEngine.FDeadList.Remove(Self);
     end;
     FList.Free;
     FDrawList.Free;
     inherited Destroy;
end;

procedure TSprite.Assign(const Value: TSprite);
begin
     FName := Value.Name;
     FImageName := Value.ImageName;
     FX  := Value.X;
     FY  := Value.Y;
     FZ  := Value.Z;
     FWorldX  := Value.WorldX;
     FWorldY  := Value.WorldY;
     FPatternIndex := Value.PatternIndex;
     FImageIndex := Value.ImageIndex;
     FCollideMode := Value.CollideMode;
     FCollisioned := Value.Collisioned;
     FCollidePos := Value.CollidePos;
     FCollideRadius := Value.CollideRadius;
     FCollideRect := Value.CollideRect;
     FCollideQuadrangle := Value.CollideQuadrangle;
     FMoved := Value.Moved;
     FBlendMode := Value.BlendMode;
     FVisible := Value.Visible;
     FTag := Value.Tag;
end;

procedure TSprite.Add(Sprite: TSprite);
begin
     if FList = nil then
     begin
          FList := TList.Create;
          FDrawList := TList.Create;
     end;
     FList.Add(Sprite);
     // optimization for HUGE large-map, to optimize load time
     //AddDrawList(Sprite);
end;

procedure TSprite.Remove(Sprite: TSprite);
begin
     FList.Remove(Sprite);
     FDrawList.Remove(Sprite);
     if FList.Count = 0 then
     begin
          FList.Free;
          FList := nil;
          FDrawList.Free;
          FDrawList := nil;
     end;
end;

procedure TSprite.AddDrawList(Sprite: TSprite);
var
   L, H, I, C: Integer;
begin
     L := 0;
     H := FDrawList.Count - 1;
     while L <= H do
     begin
          I := (L + H) div 2;
          C := TSprite(FDrawList[I]).Z - Sprite.Z;
          if C < 0 then
              L := I + 1
          else
              H := I - 1;
     end;
     FDrawList.Insert(L, Sprite);
end;

procedure TSprite.Clear;
begin
     while Count > 0 do
         Items[Count - 1].Free;
end;

procedure TSprite.Dead;
begin
     if (FEngine <> nil) and (not FDeaded) then
     begin
          FDeaded := True;
          FEngine.FDeadList.Add(Self);
     end;
end;

procedure TSprite.DoMove;
begin
end;

procedure TSprite.Move(const MoveCount: Single);
var
   i: Integer;
begin
     if FMoved then
     begin
          DoMove(MoveCount);
          for i := 0 to Count - 1 do
              Items[i].Move(MoveCount);
     end;
end;

procedure TSprite.Draw;
var
   i: Integer;
begin
     if FVisible then
     begin
          if FEngine <> nil then
          begin
               if (X > FEngine.WorldX - Width ) and
               (Y > FEngine.WorldY - Height)    and
               (X < FEngine.WorldX + FEngine.VisibleWidth)  and
               (Y < FEngine.WorldY + FEngine.VisibleHeight) then
               begin
                    DoDraw;
                    Inc(FEngine.FDrawCount);
               end;
          end;
          if FDrawList <> nil then
          begin
               for i := 0 to FDrawList.Count-1 do
                   TSprite(FDrawList[i]).Draw;
          end;
     end;
end;

function TSprite.GetCount: Integer;
begin
     if FList <> nil then
         Result := FList.Count
     else
         Result := 0;
end;

function TSprite.GetItem(Index: Integer): TSprite;
begin
     if FList <> nil then
         Result := FList[Index]
     else
         raise ESpriteError.CreateFmt('Index of the list exceeds the range. (%d)', [Index]);
end;

function TSprite.GetImageWidth: Integer;
begin
     Result := FEngine.Images.Image[FImageName].GetWidth(True);
end;

function TSprite.GetImageHeight: Integer;
begin
     Result := FEngine.Images.Image[FImageName].GetHeight(True);