csprite.cls

也是坦克大战

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cSprite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'local variable(s) to hold property value(s)
Private mvarX As Long 'local copy
Private mvarY As Long 'local copy
Private mvarddsBackBuffer As DirectDrawSurface7 'local copy
Private mvarddsBitmap As DirectDrawSurface7 'local copy
Private mvarCurrentGroup As Integer
Private mvarCurrentFrame As Integer
Private mvarDirection As SpriteDirectionConstants

Dim rcFrame() As RECT
Dim intFrameCount As Integer
Dim Group() As Collection ' Each group can have a varying number of frames.
Dim intGroupCount As Integer

Dim blnLoaded As Boolean
Dim lngScreenWidth As Long, lngScreenHeight As Long
Dim lngSpriteWidth As Long, lngSpriteHeight  As Long

Public Enum SpriteErrorConstants
    SPRITE_ERROR_GROUP_OUTOFBOUNDS = vbObjectError + 1000
    SPRITE_ERROR_FRAME_OUTOFBOUNDS = vbObjectError + 1001
End Enum



Public Property Set ddsBitmap(ByRef vData As DirectDrawSurface7)
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.ddsBitmap = Form1
    Set mvarddsBitmap = vData
End Property


Public Property Get ddsBitmap() As DirectDrawSurface7
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: 'Debug.Print X.ddsBitmap
    Set ddsBitmap = mvarddsBitmap
End Property



Public Property Set ddsBackBuffer(vData As DirectDrawSurface7)
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.ddsBackBuffer = Form1
    Dim ddsd As DDSURFACEDESC2
    Set mvarddsBackBuffer = vData
    vData.GetSurfaceDesc ddsd
    lngScreenWidth = ddsd.lWidth
    lngScreenHeight = ddsd.lHeight
End Property


Public Property Get ddsBackBuffer() As DirectDrawSurface7
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: 'Debug.Print X.ddsBackBuffer
    Set ddsBackBuffer = mvarddsBackBuffer
End Property



Public Property Let Y(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Y = 5
    mvarY = vData
End Property


Public Property Get Y() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: 'Debug.Print X.Y
    Y = mvarY
End Property



Public Property Let x(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.X = 5
    mvarX = vData
End Property


Public Property Get x() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: 'Debug.Print X.X
    x = mvarX
End Property

Public Property Get CurrentGroup() As Integer
    CurrentGroup = mvarCurrentGroup
End Property
Public Property Let CurrentGroup(ByVal vData As Integer)
    If vData > 0 And vData <= UBound(Group) Then
        mvarCurrentGroup = vData
    Else
        Err.Raise SPRITE_ERROR_GROUP_OUTOFBOUNDS
    End If
End Property

Public Property Get CurrentFrame() As Integer
    CurrentFrame = mvarCurrentFrame
End Property
Public Property Let CurrentFrame(ByVal vData As Integer)
    'Debug.Print Group(mvarCurrentGroup).Count
    If vData > 0 And vData <= Group(mvarCurrentGroup).Count Then
        mvarCurrentFrame = vData
        With rcFrame(Group(mvarCurrentGroup).Item(vData))
            lngSpriteWidth = .Right - .Left
            lngSpriteHeight = .Bottom - .Top
        End With
    Else
        'Err.Raise SPRITE_ERROR_FRAME_OUTOFBOUNDS
    End If
End Property

Public Property Get Direction() As SpriteDirectionConstants
    Direction = mvarDirection
End Property
Public Property Let Direction(ByVal vData As SpriteDirectionConstants)
    mvarDirection = vData
    CurrentFrame = vData
End Property

Public Sub drawSprite()
    Dim rc As RECT
    
    'Debug.Print vbCrLf & "start draw..."
    LSet rc = rcFrame(Group(mvarCurrentGroup).Item(mvarCurrentFrame))
    'Debug.Print "rc info: " & rc.Left, rc.Top, rc.Right, rc.Bottom
    
    If Not (mvarddsBitmap Is Nothing) And Not (mvarddsBackBuffer Is Nothing) And blnLoaded Then
        'Debug.Print "Draw now at ", mvarX, mvarY, " in " & mvarDirection
        ddsBackBuffer.BltFast mvarX - (lngSpriteWidth / 2), mvarY - (lngSpriteHeight / 2), mvarddsBitmap, rc, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
        'Debug.Print "Drawing done."
        'ddsBackBuffer.BltColorFill RectOnScreen, vbWhite
    End If
End Sub

Public Sub LoadData(strSpriteFile As String)
    Dim strTemp(1 To 4) As String
    Dim i As Integer, j As Integer, k As Integer
    Dim rc As RECT
    
    Open strSpriteFile For Input As #1
        ' Read number of frames.
        Input #1, strTemp(1)
        intFrameCount = Val(strTemp(1))
        ' Redim array to fit all frames.
        ReDim rcFrame(1 To intFrameCount) As RECT
        ' Read each frame.
        For i = 1 To intFrameCount
            Input #1, strTemp(1), strTemp(2), strTemp(3), strTemp(4)
            rc = AssignRect(Val(strTemp(1)), Val(strTemp(2)), Val(strTemp(1)) + Val(strTemp(3)), Val(strTemp(2)) + Val(strTemp(4)))
            LSet rcFrame(i) = rc
        Next i
        'Debug.Print "fc: " & intFrameCount
        
        ' Read number of groups.
        Input #1, strTemp(1)
        intGroupCount = Val(strTemp(1))
        ReDim Group(1 To intGroupCount) As Collection
        'Debug.Print "gc: " & intGroupCount
        
        ' Get each group.
        For i = 1 To intGroupCount
            ' Create new group.
            Set Group(i) = New Collection
            
            ' Read number of frame refs.
            Input #1, strTemp(1)
            k = Val(strTemp(1))
            
            ' Get each frame ref.
            For j = 1 To k
                Input #1, strTemp(1)
                Group(i).Add Val(strTemp(1))
            Next j
            
        Next i
    Close #1
    
    mvarCurrentGroup = 1
    mvarCurrentFrame = 1
    
    'Debug.Print "Frame count: " & CStr(intFrameCount) & vbCrLf & _
                "Group count: " & CStr(intGroupCount)
    With rcFrame(Group(1).Item(1))
        lngSpriteWidth = .Right - .Left
        lngSpriteHeight = .Bottom - .Top
    End With
    
    blnLoaded = True
End Sub

Public Sub moveSprite(Optional intStep = 3)
    Select Case mvarDirection
    Case dirUp:    mvarY = mvarY - intStep
    Case dirRight: mvarX = mvarX + intStep
    Case dirDown:  mvarY = mvarY + intStep
    Case dirLeft:  mvarX = mvarX - intStep
    End Select
    
    If mvarX < 100 + (lngSpriteWidth / 2) Then mvarX = 100 + (lngSpriteWidth / 2)
    If mvarX > lngScreenWidth - (lngSpriteWidth / 2) Then mvarX = lngScreenWidth - (lngSpriteWidth / 2)
    If mvarY < lngSpriteHeight / 2 Then mvarY = lngSpriteHeight / 2
    If mvarY > lngScreenHeight - (lngSpriteHeight / 2) Then mvarY = lngScreenHeight - (lngSpriteHeight / 2)
End Sub

Public Property Get SpriteWidth() As Long
    SpriteWidth = lngSpriteWidth
End Property

Public Property Get SpriteHeight() As Long
    SpriteHeight = lngSpriteHeight
End Property

Public Property Get RectOnScreen() As RECT
    Dim rc As RECT
    Dim w As Long, h As Long
    
    w = lngSpriteWidth / 2
    h = lngSpriteHeight / 2
    
    rc = AssignRect(mvarX - w, mvarY - h, mvarX + w, mvarY + h)
    RectOnScreen = rc
End Property