ReadGifHead

Public Type BITMAPINFO
Width As Long
Height As Long
End Type


Public Function GetGIFInfo(ByVal FileName As String) As BITMAPINFO
Dim bChar As Byte
Dim i As Integer
Dim DotPos As Integer
Dim Header As String
Dim blExit As Boolean
Dim a As String, b As String
Dim ImgWidth As Integer
Dim ImgHeight As Integer
Dim ImgSize As String
Dim fnum As Integer
Dim ImageInfo As BITMAPINFO

On Error Resume Next
fnum = FreeFile
Open FileName For Binary As #fnum

ImgSize = LOF(fnum) / 1024

DotPos = InStr(ImgSize, ",")
ImgSize = Left(ImgSize, DotPos - 1) '& "," _
& Left(Right(ImgSize,Len(ImgSize) - DotPos), 2)

For i = 0 To 5
Get #fnum, , bChar
Header = Header + Chr(bChar)
Next i

If Left(Header, 3) <> "GIF" Then
MsgBox FileName & ": not a GIF file"
Close #fnum
Exit Function
End
End If

Get #fnum, , bChar
a = a + Chr(bChar)
Get #fnum, , bChar
a = a + Chr(bChar)

ImgWidth = CInt(Asc(Left(a, 1)) + 256 * Asc(Right(a, 1)))

Get #fnum, , bChar
b = b + Chr(bChar)
Get #fnum, , bChar
b = b + Chr(bChar)

ImgHeight = CInt(Asc(Left(b, 1)) + 256 * Asc(Right(b, 1)))

Close #fnum

With ImageInfo
.Width = ImgWidth
.Height = ImgHeight
End With

GetGIFInfo = ImageInfo
End Function