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
Private Frames As New Collection

Private FrameIDs() As Integer

Private GifFrame() As Long 'As Collection
Public Count As Long
Private GifName As String
Private MyDC As Long, mBitmap As Long

Private cFrame As Integer
Private Interval As Integer
Private MaxInterval As Integer

Public Delay As Integer

Private Sub CleanGifFrame()
    For i = 1 To Count
        GifFrame(i) = 0
    Next
End Sub

Public Function Initialize(FileName As String, Destination As Long)

    Dim TheFile As String, sFileName As String, FrameID, FLen
    
    If Not DirectoryExist(App.Path & "\temp\") Then MkDir App.Path & "\temp\"
        
    frmMain.tmpAni.Cls
    frmMain.tmpAni2.Cls
        
    CleanGifFrame
    sFileName = FileName
    
    Dim GifEnd
    Dim FileHeader As String
    GifEnd = Chr(0) & "!ù"
    
    Open sFileName For Binary As #1
        FLen = FileLen(sFileName)
        TheFile = String(FLen, Chr(32))
        Get #1, 1, TheFile
    Close 1
    
    Dim j&
    j = (InStr(1, TheFile, GifEnd) + Len(GifEnd)) '- 2
    FileHeader = Left(TheFile, j)
    
    FrameID = Chr(33) & Chr(249)
    x = InStr(1, TheFile, FrameID)
    Count = 1
    Do Until x = 0
        ReDim Preserve GifFrame(1 To Count + 1)
        GifFrame(Count) = x
        Count = Count + 1
        x = InStr(x + 1, TheFile, FrameID)
    Loop
    
    For i = 1 To Frames.Count
    Frames.Remove i
    Next i
    
    GifFrame(Count) = FLen
    
    Dim TheFrame As String
    Dim TheHeader As String
    
    TheHeader = Left(TheFile, GifFrame(1) - 1)
    
    For i = 1 To 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
   
            Put #1, 1, TheHeader & TheFrame
            
                Dim ImgHeader As String
                ImgHeader = Left(Mid(TheFile, j - 1, Len(TheFile) - j), 16)
                Delay = ((Asc(Mid(ImgHeader, 4, 1))) + (Asc(Mid(ImgHeader, 5, 1)) * 256)) * 10

        Close 1
    Next
   
   ReDim FrameIDs(1 To Count - 1)
                                       
   For i = 1 To Count - 1
      
   Dim temp As New StdPicture
   Set temp = LoadPicture(App.Path & "\temp\" & GifName & " (frame " & Format(i, "0#") & ").bmp")
        
   SavePicture temp, App.Path & "\temp\" & GifName & " (frame " & Format(i, "0#") & ").bmp"
   
   Set temp = LoadPicture(App.Path & "\temp\" & GifName & " (frame " & Format(i, "0#") & ").bmp")
 
   frmMain.tmpAni.Picture = temp
   frmMain.tmpAni.Refresh
   
   Dim ImgWidth As Integer
   Dim ImgHeight As Integer
   
   ImgWidth = temp.Width / 26.458984375
   ImgHeight = temp.Height / 26.458984375
   
   frmMain.tmpAni.Height = ImgHeight
   frmMain.tmpAni.Width = ImgWidth
   
   frmMain.tmpAni2.Height = ImgHeight
   frmMain.tmpAni2.Width = ImgWidth * (Count - 1)
     
   BitBlt frmMain.tmpAni2.hDC, (i - 1) * ImgWidth, 0, ImgWidth, ImgHeight, frmMain.tmpAni.hDC, 0, 0, vbSrcCopy
   frmMain.tmpAni2.Refresh

   Next i
   
   Dim FinalPath As String
   FinalPath = GetPath(sFileName)
   
   SavePicture frmMain.tmpAni2.Image, App.Path & "\temp\" & "final.bmp"
   LoadAndSaveImage App.Path & "\temp\" & "final.bmp", FinalPath & GifName & ".png"
                
   frmMain.OpenImage FinalPath & GifName & ".png"
   MsgBox "Your Animated Gif File was converted to : " & vbCrLf & FinalPath & GifName & ".png", vbInformation, "Conversion"
             
   frmMain.mnuNew_Click
                  
   Animations(CurrentAnimation).SelectionW = ImgWidth
   Animations(CurrentAnimation).SelectionH = ImgHeight
   
   frmMain.shpSelect.Move 0, 0, Animations(CurrentAnimation).SelectionW + 1, Animations(CurrentAnimation).SelectionH + 1
   
   Animations(CurrentAnimation).AniCount = Count - 1
   ReDim Animations(CurrentAnimation).AniCol(0 To Animations(CurrentAnimation).AniCount)
    
   For i = 1 To Count - 1
   Animations(CurrentAnimation).AniCol(i).x = (i - 1) * ImgWidth
   Animations(CurrentAnimation).AniCol(i).y = 0
   Animations(CurrentAnimation).AniCol(i).Interval = Animations(CurrentAnimation).AnimationSpeed
   Animations(CurrentAnimation).AniCol(i).Alpha = 255
   Next i
      
   frmMain.RefreshView
          
   On Error Resume Next
   Kill App.Path & "\temp\*.bmp"
   RmDir App.Path & "\temp\"
End Function

Public Function GetPath(ByVal FullFilePath As String) As String

    Dim i As Integer
    'finds the last "\" in FullFilePath
    i = InStrRev(FullFilePath, "\", Len(FullFilePath))
    'returns the path of the file
    GetPath = Left(FullFilePath, i)
End Function
