VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2DAnimatedGif"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Frames          As New Collection
Private FrameIDs()      As Integer
Private GifFrame()      As Long    'As Collection
Private CFm_Count            As Long
Private GifName         As String
Private MyDC            As Long
Private mBitmap         As Long
Private cFrame          As Integer
Private Interval        As Integer
Private MaxInterval     As Integer
Private devil           As New cDevIL
Private Image           As cDevILImage
Private CFm_Delay            As Integer
Public S2D As cS2D_i

Public Property Get Count() As Long


    Count = CFm_Count

End Property

Public Property Let Count(ByVal PropVal As Long)

    CFm_Count = PropVal

End Property

Public Property Get Delay() As Integer
    Delay = CFm_Delay

End Property

Public Property Let Delay(ByVal PropVal As Integer)

    CFm_Delay = PropVal

End Property

Private Function Between(ByVal lFrom As Long, _
                         ByVal lTo As Long)


  Dim j As Integer
  Dim l As Long
  
  For j = lFrom To lTo
        l = l + 1
    Next '  J
    Between = l

End Function

Private Sub CleanGifFrame()
Dim i As Integer
    For i = 1 To CFm_Count
        GifFrame(i) = 0
    Next '  I

End Sub

Private Function GetFileNameFromPath(ByVal FullFilePath As String, _
                                     ByVal bExtension As Boolean) As String


  Dim sFileName As String
  Dim FindSlash As Long

    If LenB(FullFilePath) = 0 Then
        Exit Function
    End If
    FindSlash = InStrRev(FullFilePath, "\")
    sFileName = Mid$(FullFilePath, FindSlash + 1, Between(FindSlash, Len(FullFilePath)))
    If bExtension Then
        GetFileNameFromPath = sFileName
     Else 'BEXTENSION = FALSE/0
        GetFileNameFromPath = Left$(sFileName, Len(sFileName) - Between(InStrRev(sFileName, "."), Len(sFileName)))
    End If

End Function

Public Sub Initialize(ByVal strFilename As String, _
                      ByVal colorkey As Long)

  
  Dim No         As String
  Dim D          As Long
  Dim x As String
  Dim GifEnd     As String
  Dim FileHeader As String
  Dim j          As Long
  Dim TheFrame   As String
  Dim TheHeader  As String
  Dim ImgHeader  As String
  Dim Temp       As New StdPicture
  Dim TheFile    As String
  Dim sFileName  As String
  Dim FrameID    As String
  Dim FLen       As Long
    If Not DirectoryExist(App.Path & "\temp\") Then
        MkDir App.Path & "\temp\"
    End If
    CleanGifFrame
    sFileName = strFilename
    GifEnd = Chr$(0) & "!ù"
    Open sFileName For Binary As #1
    FLen = FileLen(sFileName)
    TheFile = String$(FLen, Chr$(32))
    Get #1, 1, TheFile
    Close 1
    j = (InStr(1, TheFile, GifEnd) + Len(GifEnd)) '- 2
    FileHeader = Left$(TheFile, j)
    FrameID = Chr$(33) & Chr$(249)
    x = InStr(1, TheFile, FrameID)
    CFm_Count = 1
    Do Until x = 0
        ReDim Preserve GifFrame(1 To CFm_Count + 1)
        GifFrame(CFm_Count) = x
        CFm_Count = CFm_Count + 1
        x = InStr(x + 1, TheFile, FrameID)
    Loop
    
    Dim i As Integer
    For i = 1 To Frames.Count
        Frames.Remove i
    Next i
    GifFrame(CFm_Count) = FLen
    TheHeader = Left$(TheFile, GifFrame(1) - 1)
    For i = 1 To CFm_Count - 1
        Frames.Add GifFrame(i)
        GifName = GetFileNameFromPath(sFileName, False)
        Open App.Path & "\temp\" & GetFileNameFromPath(sFileName, False) & " ( frame " & Format(i, "0#") & " ) .bmp" For Binary As #1
        TheFrame = Mid$(TheFile, GifFrame(i), Between(GifFrame(i), GifFrame(i + 1)) - 1)
        No = ""
        For D = 1 To 8
            Select Case D
             Case 3, 5, 7
                No = No & " " & Format$(Hex$(Asc(Mid$(TheFrame, D, 1))), "00")
             Case Else
                No = No & Format$(Hex$(Asc(Mid$(TheFrame, D, 1))), "00")
            End Select
        Next '  D
        Put #1, 1, TheHeader & TheFrame
        ImgHeader = Left$(Mid$(TheFile, j - 1, Len(TheFile) - j), 16)
        CFm_Delay = ((Asc(Mid$(ImgHeader, 4, 1))) + (Asc(Mid$(ImgHeader, 5, 1)) * 256)) * 10
        Close 1
    Next '  I
    ReDim FrameIDs(1 To CFm_Count - 1)
    For i = 1 To CFm_Count - 1
        With App
            Set Temp = LoadPicture(.Path & "\temp\" & GifName & " ( frame " & Format$(i, "0#") & " ) .bmp")
            SavePicture Temp, .Path & "\temp\" & GifName & " ( frame " & Format$(i, "0#") & " ) .bmp"
            FrameIDs(i) = S2D.TexturePool.AddTexture(.Path & "\temp\" & GifName & " ( frame " & Format$(i, "0#") & " ) .bmp", D3DColorARGB(255, 0, 255, 0))
        End With 'App
    Next i
    cFrame = 1
    MaxInterval = 5
    On Error Resume Next
    Kill App.Path & "\temp\*.bmp"
    RmDir App.Path & "\temp\"
    On Error GoTo 0

End Sub

Public Sub Render(Optional x As Double = 0, Optional y As Double = 0)

     If Interval < MaxInterval Then
        Interval = Interval + 1
     Else 'NOT INTERVAL...
        If cFrame < CFm_Count - 1 Then
            cFrame = cFrame + 1
         Else 'NOT CFRAME...
            cFrame = 1
        End If
        Interval = 0
    End If
    S2D.TexturePool.RenderTexture FrameIDs(cFrame), x, y

End Sub
