Snippet Library

none

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;