Visual Basic Game Programming for Teens/VBGPFT.cdr/sources/chapter18/CelticCrusader3/Sprite.bas

BASIC Source File | 2004-11-12 | 5.1 KB | 203 lines

Attribute VB_Name = "Sprite"
'---------------------------------------------------------------
' Visual Basic Game Programming for Teens
' Sprite Support File
'---------------------------------------------------------------

Option Explicit
Option Base 0


'sprite properties
Public Type TSPRITE
    spriteObject As D3DXSprite
    x As Long
    y As Long
    width As Long
    height As Long
    FramesPerRow As Long
    StartFrame As Long
    FrameCount As Long
    CurrentFrame As Long
    Animating As Boolean
    AnimSeq As Long
    AnimDelay As Long
    AnimCount As Long
    SpeedX As Long
    SpeedY As Long
    DirX As Long
    DirY As Long
    ScaleFactor As Single
End Type

Public Function LoadTexture(ByRef dev As Direct3DDevice8, ByVal filename As String) As Direct3DTexture8
    On Local Error GoTo error1

    Dim d3dx As New D3DX8
    Dim tex As Direct3DTexture8

    'load the source bitmap file into a texture
    Set tex = d3dx.CreateTextureFromFileEx( _
        dev, _
        filename, _
        D3DX_DEFAULT, _
        D3DX_DEFAULT, _
        1, 0, _
        D3DFMT_UNKNOWN, _
        D3DPOOL_MANAGED, _
        D3DX_FILTER_NONE, _
        D3DX_FILTER_NONE, _
        &HFF00FF, _
        ByVal 0, ByVal 0)

    If tex Is Nothing Then
        MsgBox "Error loading " & filename, vbOKOnly, "Error"
        Set LoadTexture = Nothing
    Else
        Set LoadTexture = tex
    End If

    Exit Function

error1:
    MsgBox "Error loading " & filename, vbOKOnly, "Error"
    Set LoadTexture = Nothing
End Function

Public Sub InitSprite(ByRef dev As Direct3DDevice8, ByRef spr As TSPRITE)

    Set spr.spriteObject = d3dx.CreateSprite(dev)

    spr.StartFrame = 0
    spr.CurrentFrame = 0
    spr.FramesPerRow = 1
    spr.FrameCount = 1
    spr.Animating = False
    spr.AnimCount = 0
    spr.AnimDelay = 0
    spr.ScaleFactor = 1
    spr.x = 0
    spr.y = 0
    spr.width = 0
    spr.height = 0
    spr.SpeedX = 0
    spr.SpeedY = 0
    spr.DirX = 0
    spr.DirY = 0

End Sub

Public Sub DrawSprite(ByRef tex As Direct3DTexture8, ByRef spr As TSPRITE, ByVal alpha As Long)
    Dim vecScale As D3DVECTOR2
    vecScale.x = spr.ScaleFactor
    vecScale.y = spr.ScaleFactor

    Dim pos As D3DVECTOR2
    pos.x = spr.x
    pos.y = spr.y

    Dim vecRot As D3DVECTOR2
    vecRot.x = 0
    vecRot.y = 0

    'enable sprite drawing
    spr.spriteObject.Begin

    'set the source rect
    Dim r As RECT
    r.Left = (spr.CurrentFrame Mod spr.FramesPerRow) * spr.width
    r.Top = (spr.CurrentFrame \ spr.FramesPerRow) * spr.height
    r.Right = r.Left + spr.width
    r.bottom = r.Top + spr.height

    'draw the sprite
    spr.spriteObject.Draw tex, r, vecScale, vecRot, 0, pos, alpha

    'stop sprite drawing
    spr.spriteObject.End
End Sub

'added in chapter12--needs to be inserted back into chapter 10
Public Sub AnimateSprite(ByRef spr As TSPRITE)
    Dim frameindex As Long

    With spr
        'increment the animation counter
        .AnimCount = .AnimCount + 1

        'has the animation counter waited long enough?
        If .AnimCount > .AnimDelay Then
            .AnimCount = 0

            'okay, go to the next frame
            .CurrentFrame = .CurrentFrame + 1

            frameindex = .AnimSeq * .FrameCount
            If (.CurrentFrame < frameindex) Or (.CurrentFrame > frameindex + .FrameCount - 1) Then
                .CurrentFrame = frameindex
                .Animating = False
            End If
        End If
    End With

End Sub

Public Sub PrintText( _
    ByRef fontImg As Direct3DTexture8, _
    ByRef fontSpr As TSPRITE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal color As Long, _
    ByVal sText As String)

    Dim n As Long
    For n = 1 To Len(sText)
        PrintChar fontImg, fontSpr, x + (n - 1) * fontSpr.width, y, color, Asc(Mid$(sText, n, 1))
    Next n

End Sub

Public Sub PrintChar( _
    ByRef fontImg As Direct3DTexture8, _
    ByRef fontSpr As TSPRITE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal color As Long, _
    c As Byte)

    fontSpr.x = x
    fontSpr.y = y
    fontSpr.CurrentFrame = c - 32
    DrawSprite fontImg, fontSpr, color

End Sub

Public Function Collision(ByRef sprite1 As TSPRITE, ByRef sprite2 As TSPRITE) As Boolean
    Dim dest As RECT
    Dim rect1 As RECT
    Dim rect2 As RECT

    'set up the first rect
    rect1.Left = sprite1.x + sprite1.width / 4
    rect1.Top = sprite1.y + sprite1.height / 4
    rect1.Right = rect1.Left + sprite1.width / 2
    rect1.bottom = rect1.Top + sprite1.height / 2

    'set up the second rect
    rect2.Left = sprite2.x + sprite2.width / 4
    rect2.Top = sprite2.y + sprite2.height / 4
    rect2.Right = rect2.Left + sprite2.width / 2
    rect2.bottom = rect2.Top + sprite2.height / 2

    'check for collision
    If IntersectRect(dest, rect1, rect2) <> 0 Then
        Collision = True
    Else
        Collision = False
    End If
End Function