Code:
Option Explicit
Private Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
Private Type LogicalScreenDescriptor
GifWidth As Long
GifHeight As Long
GlobalColorSize As Long
SortFlag As Long
ColorResolution As Long
GlobalColorFlag As Long
Backcolor As Long
PixelRadio As Long
End Type
Private Type GraphicControl
Disposal As Long
Delay As Long
TransparentColor As Long
End Type
Private Type ImageDescription
FrameLeft As Long
FrameTop As Long
FrameWidth As Long
FrameHeight As Long
End Type
Public Sub LoadGifFile(strFileName As String, aimg As Variant)
Dim GifHeader As GifType
Dim strLogicalScreenDescription As String
Dim LSDLogicalScreenDescription As LogicalScreenDescriptor
Dim GCGraficControl As GraphicControl
Dim IDImageDescription As ImageDescription
Dim strGifHeader As String
Dim strFrame As String
Dim fNum As Integer
Dim FileBuffer As String
Dim PictureBuffer As String
Dim PackedField As String
Dim FirstFrame As Long
Dim i As Integer
'Test if the file exists
If Dir$(strFileName) = "" Or strFileName = "" Then
MsgBox "File " & strFileName & " not found", vbCritical
Exit Sub
End If
'Put all file info to a variable
fNum = FreeFile
Open strFileName For Binary Access Read As fNum
FileBuffer = String(LOF(fNum), Chr(0))
Get #fNum, , FileBuffer
Close fNum
'unload all pictureboxes\images
For i = 1 To aimg.Count - 1
Unload aimg(i)
Next i
'Gif Header
strGifHeader = Left$(FileBuffer, 6)
If strGifHeader = "GIF87a" Then
GifHeader = GIF87A
ElseIf strGifHeader = "GIF89a" Then
GifHeader = GIF89A
End If
'Test if the Gif is animated or not
FirstFrame = InStr(13, FileBuffer, Chr(33) & Chr(249))
'if the image isn't animated, then just draw it;)
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
aimg(0).Picture = LoadPicture(strFileName)
Exit Sub
End If
'Logical Screen Description
strLogicalScreenDescription = Mid$(FileBuffer, 7, 7)
LSDLogicalScreenDescription.GifWidth = Asc(Left$(strLogicalScreenDescription, 2))
LSDLogicalScreenDescription.GifHeight = Asc(Mid$(strLogicalScreenDescription, 2, 2))
PackedField = Asc(Mid$(strLogicalScreenDescription, 5, 1))
PackedField = DecimalToBinary(PackedField)
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 1, 1)))
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 5, 1)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
LSDLogicalScreenDescription.Backcolor = Asc(Mid$(strLogicalScreenDescription, 6, 1))
LSDLogicalScreenDescription.PixelRadio = Asc(Mid$(strLogicalScreenDescription, 7, 1))
'image count
i = 0
Do
'get frame string
strFrame = Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - FirstFrame)
'Get Grafic Control
PackedField = Asc(Mid$(strFrame, 4, 1))
PackedField = DecimalToBinary(PackedField)
GCGraficControl.Disposal = Asc(BinaryToDecimal(Mid$(PackedField, 4, 3)))
GCGraficControl.Delay = Asc(Mid$(strFrame, 5, 2))
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
'Get Image Description
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 2))
IDImageDescription.FrameTop = Asc(Mid$(strFrame, 12, 2))
IDImageDescription.FrameWidth = Asc(Mid$(strFrame, 14, 2))
IDImageDescription.FrameHeight = Asc(Mid$(strFrame, 16, 2))
'If the image array don't exist then create\load it
If i > 0 Then
Load aimg(i)
End If
'create the image temp
fNum = FreeFile
Open "temp.gif" For Binary As fNum
Debug.Print Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) ' error '13': type mismatch
If Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) <> 0 Then
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(strFrame, 0, Len(FileBuffer) - strFrame - 1) & Chr(59) '3B
Else
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(strFrame, 0, Len(FileBuffer) - 1) & Chr(59) '3B
End If
Put #fNum, 1, PictureBuffer
Close fNum
'now load the image
aimg(i).Picture = LoadPicture("temp.gif")
'now we can delete the temp file
Kill "temp.gif"
'change the properties
aimg(i).Tag = GCGraficControl.Delay
'test if theres another image
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
Exit Do
Else
FirstFrame = InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249))
End If
i = i + 1
Loop
Debug.Print i
End Sub
see on do...loop code. in last lines i'm trying put all data on string.