VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sprite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Enum SpriteTypeConstants
    stcNone = 0
    stcSPR = 1
    stcS16_555 = 2
    stcS16_565 = 3
End Enum

Private m_eType As SpriteTypeConstants
Private m_nNumberOfSpritesInFile As Integer
Private m_oSpriteImages As New Collection

Public Property Get SpriteType() As SpriteTypeConstants
    SpriteType = m_eType
End Property

Public Property Let SpriteType(ByVal vNewValue As SpriteTypeConstants)
    If m_eType <> vNewValue Then
        ConvertSpriteImages vNewValue
        m_eType = vNewValue
    End If
End Property

Public Property Get NumberOfSpritesInFile() As Integer
    If m_nNumberOfSpritesInFile <> m_oSpriteImages.Count Then
        m_nNumberOfSpritesInFile = m_oSpriteImages.Count
    End If
    
    NumberOfSpritesInFile = m_nNumberOfSpritesInFile
End Property

Public Function NewSpriteImage(Optional aPixels, Optional ByVal nSpriteWidth As Integer, Optional ByVal nSpriteHeight As Integer) As Bitmap
    Dim oSpriteImage As New Bitmap
    
    Select Case m_eType
        Case stcSPR
            oSpriteImage.BitsPerPixel = 8
            
        Case stcS16_555
            oSpriteImage.BitsPerPixel = 15
            
        Case stcS16_565
            oSpriteImage.BitsPerPixel = 16
    End Select
    
    If Not IsMissing(aPixels) Then
        oSpriteImage.SetPixelArray aPixels
    End If
    
    If Not IsMissing(nSpriteWidth) Then
        oSpriteImage.Width = nSpriteWidth
    End If
    
    If Not IsMissing(nSpriteHeight) Then
        oSpriteImage.Height = nSpriteHeight
    End If
    
    Set NewSpriteImage = oSpriteImage
End Function

Public Sub AddSpriteImage(ByVal oSpriteImage As Bitmap)
    Dim nBitsPerPixel As Integer
    
    Select Case m_eType
        Case stcSPR
            nBitsPerPixel = 8
            
        Case stcS16_555
            nBitsPerPixel = 15
            
        Case stcS16_565
            nBitsPerPixel = 16
    End Select
    
    If oSpriteImage.BitsPerPixel <> nBitsPerPixel Then
        oSpriteImage.ConvertToImageType m_eType
        m_oSpriteImages.Add oSpriteImage
'        Select Case oSpriteImage.BitsPerPixel
'            Case 8
'                m_oSpriteImages.Add ConvertSpriteImage(stcSPR, m_eType, oSpriteImage)
'
'            Case 15
'                m_oSpriteImages.Add ConvertSpriteImage(stcS16_555, m_eType, oSpriteImage)
'
'            Case 16
'                m_oSpriteImages.Add ConvertSpriteImage(stcS16_565, m_eType, oSpriteImage)
'        End Select
    Else
        m_oSpriteImages.Add oSpriteImage
    End If
    
    m_nNumberOfSpritesInFile = m_nNumberOfSpritesInFile + 1
End Sub

Public Sub InsertSpriteImage(ByVal Index, ByVal oSpriteImage As Bitmap)
    Dim oNewSprites As New Collection
    Dim I As Integer
    Dim nBitsPerPixel As Integer
    
    For I = 1 To Index - 1
        oNewSprites.Add m_oSpriteImages(I)
    Next
    
    Select Case m_eType
        Case stcSPR
            nBitsPerPixel = 8
            
        Case stcS16_555
            nBitsPerPixel = 15
            
        Case stcS16_565
            nBitsPerPixel = 16
    End Select
    
    If oSpriteImage.BitsPerPixel <> nBitsPerPixel Then
        oSpriteImage.ConvertToImageType m_eType
        oNewSprites.Add oSpriteImage
'        Select Case oSpriteImage.BitsPerPixel
'            Case 8
'                oNewSprites.Add ConvertSpriteImage(stcSPR, m_eType, oSpriteImage)
'
'            Case 15
'                oNewSprites.Add ConvertSpriteImage(stcS16_555, m_eType, oSpriteImage)
'
'            Case 8
'                oNewSprites.Add ConvertSpriteImage(stcS16_565, m_eType, oSpriteImage)
'        End Select
    Else
        oNewSprites.Add oSpriteImage
    End If
    
    For I = Index To m_oSpriteImages.Count
        oNewSprites.Add m_oSpriteImages(I)
    Next
    
    Set m_oSpriteImages = oNewSprites
    
    m_nNumberOfSpritesInFile = m_nNumberOfSpritesInFile + 1
End Sub

Public Sub DeleteSpriteImage(ByVal Index)
    m_oSpriteImages.Remove Index
End Sub

Public Property Get SpriteImages(ByVal Index) As Bitmap
    Set SpriteImages = m_oSpriteImages(Index)
End Property

Public Function LoadSpriteFile(ByVal sFilename As String) As Boolean
    Dim nFile As Integer
    Dim aSpriteOffset() As Long
    Dim I As Integer
    Dim nSpriteWidth As Integer
    Dim nSpriteHeight As Integer
    Dim aSpriteImagePixels() As Byte
    Dim oSpriteImage As Bitmap
    
    LoadSpriteFile = False
    
    nFile = FreeFile
    
    On Error Resume Next
    
    Open sFilename For Binary Access Read As nFile
    If Err Then
        MsgBox "Error opening file '" & sFilename & "':" & vbCrLf & vbCrLf & Err.Description, vbExclamation, "Loading File..."
        Err.Clear
        Exit Function
    End If
    
    On Error GoTo 0
    
    m_eType = stcSPR
    
    Set m_oSpriteImages = New Collection
    
    Get nFile, , m_nNumberOfSpritesInFile
    
    If m_nNumberOfSpritesInFile <= 0 Then
        Close nFile
        Exit Function
    Else
        ReDim aSpriteOffset(1 To m_nNumberOfSpritesInFile) As Long
               
        For I = 1 To m_nNumberOfSpritesInFile
            Get nFile, , aSpriteOffset(I)
            Get nFile, , nSpriteWidth
            Get nFile, , nSpriteHeight
            
            Set oSpriteImage = New Bitmap
            oSpriteImage.BitsPerPixel = 8
            oSpriteImage.Width = nSpriteWidth
            oSpriteImage.Height = nSpriteHeight
            m_oSpriteImages.Add oSpriteImage
        Next
        
        For I = 1 To m_nNumberOfSpritesInFile
            Set oSpriteImage = m_oSpriteImages(I)
            ReDim aSpriteImagePixels(0 To CLng(oSpriteImage.Width) * CLng(oSpriteImage.Height) - 1)
            Get nFile, aSpriteOffset(I) + 1, aSpriteImagePixels
            oSpriteImage.SetPixelArray aSpriteImagePixels
        Next
        
        Close nFile
        
        LoadSpriteFile = True
    End If
End Function

Public Function SaveSpriteFile(ByVal sFilename As String) As Boolean
    Dim nFile As Integer
    Dim I As Integer
    Dim nOffset As Long
    Dim aPixels() As Byte
    Dim nSpriteWidth As Integer
    Dim nSpriteHeight As Integer
    
    SaveSpriteFile = False
    
    nFile = FreeFile
    
    On Error Resume Next
    
    Kill sFilename
    Err.Clear
    
    Open sFilename For Binary Access Write As nFile
    If Err Then
        Err.Clear
        MsgBox "Error opening file '" & sFilename & "':" & vbCrLf & vbCrLf & Err.Description, vbExclamation, "Saveing File..."
        Exit Function
    End If
    
    On Error GoTo 0
    
    Put nFile, , m_nNumberOfSpritesInFile
    
    nOffset = 2 + m_nNumberOfSpritesInFile * 8
    
    For I = 1 To m_nNumberOfSpritesInFile
        Put nFile, , nOffset
        nSpriteWidth = m_oSpriteImages(I).Width
        Put nFile, , nSpriteWidth
        nSpriteHeight = m_oSpriteImages(I).Height
        Put nFile, , nSpriteHeight
        nOffset = nOffset + m_oSpriteImages(I).Width * m_oSpriteImages(I).Height
    Next
    
    For I = 1 To m_nNumberOfSpritesInFile
        m_oSpriteImages(I).GetPixelArray aPixels
        Put nFile, , aPixels
    Next
    
    Close nFile
    
    SaveSpriteFile = True
End Function

Public Function LoadS16File(ByVal sFilename As String) As Boolean
    Dim nFile As Integer
    Dim aSpriteOffset() As Long
    Dim I As Integer
    Dim nS16Header As Long
    Dim nSpriteWidth As Integer
    Dim nSpriteHeight As Integer
    Dim aSpriteImagePixels() As Byte
    Dim oSpriteImage As Bitmap
    
    LoadS16File = False
    
    nFile = FreeFile
    
    On Error Resume Next
    
    Open sFilename For Binary Access Read As nFile
    If Err Then
        MsgBox "Error opening file '" & sFilename & "':" & vbCrLf & vbCrLf & Err.Description, vbExclamation, "Loading File..."
        Err.Clear
        Exit Function
    End If
    
    On Error GoTo 0
    
    Set m_oSpriteImages = New Collection
    
    Get nFile, , nS16Header
    
    Select Case nS16Header
        Case 0
            m_eType = stcS16_555
            
        Case 1
            m_eType = stcS16_565
    End Select
    
    Get nFile, , m_nNumberOfSpritesInFile
        
    If m_nNumberOfSpritesInFile <= 0 Then
        Close nFile
        Exit Function
    Else
        ReDim aSpriteOffset(1 To m_nNumberOfSpritesInFile) As Long
               
        For I = 1 To m_nNumberOfSpritesInFile
            Get nFile, , aSpriteOffset(I)
            Get nFile, , nSpriteWidth
            Get nFile, , nSpriteHeight
            
            Set oSpriteImage = New Bitmap
            Select Case m_eType
                Case stcS16_555
                    oSpriteImage.BitsPerPixel = 15
                    
                Case stcS16_565
                    oSpriteImage.BitsPerPixel = 16
            End Select
            oSpriteImage.Width = nSpriteWidth
            oSpriteImage.Height = nSpriteHeight
            m_oSpriteImages.Add oSpriteImage
        Next
        
        For I = 1 To m_nNumberOfSpritesInFile
            Set oSpriteImage = m_oSpriteImages(I)
            ReDim aSpriteImagePixels(0 To CLng(oSpriteImage.Width) * 2 * CLng(oSpriteImage.Height) - 1)
            Get nFile, aSpriteOffset(I) + 1, aSpriteImagePixels
            oSpriteImage.SetPixelArray aSpriteImagePixels
        Next
        
        Close nFile
        
        LoadS16File = True
    End If
End Function

Public Function SaveS16File(ByVal sFilename As String) As Boolean
    Dim nFile As Integer
    Dim I As Integer
    Dim nOffset As Long
    Dim aPixels() As Byte
    Dim nS16Header As Long
    Dim nTemp As Integer
    
    SaveS16File = False
    
    nFile = FreeFile
    
    On Error Resume Next
    
    Kill sFilename
    Err.Clear
    
    Open sFilename For Binary Access Write As nFile
    If Err Then
        Err.Clear
        MsgBox "Error opening file '" & sFilename & "':" & vbCrLf & vbCrLf & Err.Description, vbExclamation, "Saveing File..."
        Exit Function
    End If
    
    On Error GoTo 0
    
    Select Case m_eType
        Case stcS16_555
            nS16Header = 0
            
        Case stcS16_565
            nS16Header = 1
    End Select
    
    Put nFile, , nS16Header
    
    Put nFile, , m_nNumberOfSpritesInFile
    
    nOffset = 4 + 2 + m_nNumberOfSpritesInFile * 8
    
    For I = 1 To m_nNumberOfSpritesInFile
        Put nFile, , nOffset
        nTemp = m_oSpriteImages(I).Width
        Put nFile, , nTemp
        nTemp = m_oSpriteImages(I).Height
        Put nFile, , nTemp
        nOffset = nOffset + m_oSpriteImages(I).Width * m_oSpriteImages(I).Height * 2
    Next
    
    For I = 1 To m_nNumberOfSpritesInFile
        m_oSpriteImages(I).GetPixelArray aPixels
        Put nFile, , aPixels
    Next
    
    Close nFile
    
    SaveS16File = True
End Function

Public Function Save(ByVal sFilename As String) As Boolean
    Select Case m_eType
        Case stcSPR
            Save = SaveSpriteFile(sFilename)
            
        Case stcS16_555, stcS16_565
            Save = SaveS16File(sFilename)
    End Select
End Function

Private Sub ConvertSpriteImages(ByVal eNewType As SpriteTypeConstants)
    Dim oSpriteImage As Bitmap
    'Dim oNewSpriteImage As Bitmap
    'Dim oNewSpriteImages As New Collection
    Dim I As Integer
    
    For I = 1 To m_oSpriteImages.Count
        Set oSpriteImage = m_oSpriteImages(I)
        oSpriteImage.ConvertToImageType eNewType
        'Set oNewSpriteImage = ConvertSpriteImage(m_eType, eNewType, oSpriteImage)
        'oNewSpriteImages.Add oNewSpriteImage
    Next
    
    'Set m_oSpriteImages = oNewSpriteImages
End Sub

'Private Function ConvertSpriteImage(ByVal eOldType As SpriteTypeConstants, ByVal eNewType As SpriteTypeConstants, ByVal oSpriteImage As Bitmap)
'    Dim oNewSpriteImage As Bitmap
'    Dim aPixels() As Byte
'    Dim aNewPixels() As Byte
'    Dim X As Long
'    Dim Y As Long
'
'    Set oNewSpriteImage = New Bitmap
'
'    With oNewSpriteImage
'        Select Case eNewType
'            Case stcSPR
'                .BitsPerPixel = 8
'
'            Case stcS16_555
'                .BitsPerPixel = 15
'
'            Case stcS16_565
'                .BitsPerPixel = 16
'        End Select
'
'        .Width = oSpriteImage.Width
'        .Height = oSpriteImage.Height
'    End With
'
'    If oNewSpriteImage.Width > 0 And oNewSpriteImage.Height > 0 Then
'        oNewSpriteImage.AllocatePixelArray
'        oNewSpriteImage.GetPixelArray aNewPixels
'
'        oSpriteImage.GetPixelArray aPixels
'
'        ConvertImage oSpriteImage.Width, oSpriteImage.Height, eOldType, aPixels(0), eNewType, aNewPixels(0)
'
'        oNewSpriteImage.SetPixelArray aNewPixels
'    End If
'
'    Set ConvertSpriteImage = oNewSpriteImage
'End Function
