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

Private Type AniFrame
    x                             As Integer
    y                             As Integer
    Interval                      As Integer
    Alpha                         As Integer
    Rotation                      As Integer
    Additive                      As Boolean
End Type

Private Type Animation
    AniCol() As AniFrame
    AniCount As Integer
    SelectionW As Integer
    SelectionH As Integer
    AnimationSpeed As Integer
    TColor As Long
    Name As String
End Type

Private Animations() As Animation
Public AnimationCount As Integer
Public CurrentAnimation As Integer

Public SelectionW As Integer
Public SelectionH As Integer

Private AniPause As Boolean
Private AniPauseFrame As Integer

Private PicFile As String
Private CurrentFrame As Integer
Private LastTimeCheckFrame As Long
Public TexID As Integer
Public RemoteControl As Boolean
Public RemoteFrame As Integer
Public FileName As String

Private CFm_S2D                      As cS2D_i

Public Function GetAnimationFrames(A As Integer) As Long
    GetAnimationFrames = Animations(A).AniCount
End Function

Public Function ChangeAnimation(Name As String)

    Dim i As Integer
    For i = 1 To AnimationCount
        If LCase(Animations(i).Name) = LCase(Name) Then
            
            If CurrentAnimation = i Then Exit Function
            CurrentAnimation = i
            CurrentFrame = 1
            Exit Function
            
        End If
    Next i

End Function

Public Property Get Width() As Integer
    Width = SelectionW
End Property

Public Property Get Height() As Integer
    Height = SelectionH
End Property

Public Property Get S2D() As cS2D_i
    Set S2D = CFm_S2D
End Property

Public Property Set S2D(PropVal As cS2D_i)
    Set CFm_S2D = PropVal
End Property

Public Sub LoadAniQ(ByVal strFilename As String)

    If TexID > 0 Then CFm_S2D.TexturePool.RemoveTexture TexID

    Dim l     As Integer
    Dim Color As ColorRGB
    Dim ImgPath As String
    Dim tmp() As String

    Open strFilename For Binary Access Read As #2
    
        Get #2, , l
        PicFile = String(l, Chr(0))
        Get #2, , PicFile
        
        Get #2, , AnimationCount
        ReDim Animations(AnimationCount)
        
        Dim m As Integer
        For m = 1 To AnimationCount
        Get #2, , Animations(m).TColor
        Get #2, , Animations(m).SelectionW
        Get #2, , Animations(m).SelectionH
        Get #2, , Animations(m).AnimationSpeed
        Get #2, , Animations(m).AniCount
        
        Get #2, , l
        Animations(m).Name = String(l, Chr(0))
        Get #2, , Animations(m).Name
        
        ReDim Animations(m).AniCol(0 To Animations(m).AniCount)
        
        Dim i As Integer
            For i = 1 To Animations(m).AniCount
               Get #2, , Animations(m).AniCol(i)
            Next i
        Next m
        
        CurrentAnimation = 1
        Color = SplitColor(Animations(CurrentAnimation).TColor)
        tmp = Split(strFilename, "\")
        
        TexID = S2D.TexturePool.AddTexture("images\" & PicFile, D3DColorARGB(255, Color.r, Color.g, Color.B))
        
        SelectionW = Animations(CurrentAnimation).SelectionW
        SelectionH = Animations(CurrentAnimation).SelectionH
    
    Close #2
    
    CurrentFrame = 1

End Sub

Public Sub Render(ByVal x As Double, ByVal y As Double, Optional DestinationWidth As Integer = -1, Optional DestinationHeight As Integer = -1, Optional bAlpha As Integer = 255, Optional Angle As Integer = 0, Optional Additive As Boolean = False, Optional Color As Long = vbWhite)

    Dim clr As Long
    clr = Color

    If Animations(CurrentAnimation).AniCount > 0 Then
        
        If Not RemoteControl Then
            If GetTickCount - LastTimeCheckFrame >= Animations(CurrentAnimation).AniCol(CurrentFrame).Interval Then
               LastTimeCheckFrame = GetTickCount
               
                If Not AniPause Then
                    If CurrentFrame < Animations(CurrentAnimation).AniCount Then
                       CurrentFrame = CurrentFrame + 1
                    Else
                       CurrentFrame = 1
                    End If
                Else
                    CurrentFrame = AniPauseFrame
                    If CurrentFrame > Animations(CurrentAnimation).AniCount Then CurrentFrame = Animations(CurrentAnimation).AniCount
                End If
            End If
        Else
            CurrentFrame = RemoteFrame
        End If
        
        If DestinationWidth = -1 Then
            DestinationWidth = Animations(CurrentAnimation).SelectionW
        End If
        
        If DestinationHeight = -1 Then
            DestinationHeight = Animations(CurrentAnimation).SelectionH
        End If
        
        If bAlpha = 255 Then
            bAlpha = Animations(CurrentAnimation).AniCol(CurrentFrame).Alpha
        End If
        
        If Angle = 0 Then
            Angle = Animations(CurrentAnimation).AniCol(CurrentFrame).Rotation
        End If
        
        S2D.TexturePool.RenderTexture TexID, x, y, DestinationWidth, DestinationHeight, Animations(CurrentAnimation).SelectionW, Animations(CurrentAnimation).SelectionH, Animations(CurrentAnimation).AniCol(CurrentFrame).x, Animations(CurrentAnimation).AniCol(CurrentFrame).y, bAlpha, Angle, , , , clr
    End If

End Sub

Public Sub Unload()
    CFm_S2D.TexturePool.RemoveTexture TexID
    TexID = -1
End Sub

Public Function StopAnimation(Optional Frame As Integer = 1)
    If AniPause Then Exit Function
    AniPause = True
    AniPauseFrame = Frame
End Function

Public Function PlayAnimation(Optional Frame As Integer = 1)
    If Not AniPause Then Exit Function
    AniPause = False
    CurrentFrame = Frame
End Function

Public Function AnimationInterval(Frame As Integer) As Integer
    AnimationInterval = Animations(CurrentAnimation).AniCol(Frame).Interval
End Function

Public Function AnimationFrameCount() As Integer
    AnimationFrameCount = Animations(CurrentAnimation).AniCount
End Function
