VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsGIFInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'       GIF info version 1.02
'  Written by Mike D Sutton of EDais
'     Microsoft Visual Basic MVP
'
' E-Mail: EDais@mvps.org
' WWW: Http://www.mvps.org/EDais/
'
' Written: 23/07/2002
' Last edited: 29/07/2003

'Version history:
'----------------

' Version 1.02 (29/07/2003):
'   Minor non-impact code modifications

' Version 1.01 (26/07/2002):
'   Changed GetGIFPalEntry() to GetPalEntry() to generalise the interface
'       and minor (non-impact) changes to the code.

' Version 1.0 (25/07/2002):
'   Added FileName, FileSize, Version, Width, Height, Background, Aspect,
'         BitDepth, HasGlobalColourTable and IsTerminated properties
'
'   ReadFile()     - Reads an GIF file off disk and extracts information about it
'   GetPalEntry()  - Returns the RGB value of an entry from the global colour palette or -1 if out of bounds
'   ClearInfo()    - Clears the public information within the class
'   SWordToUWord() - Converts a signed Word to an unsigned DWord (Surprisingly..)
'------------------'

Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type typGIFHeader ' 13 bytes
    ghSignitare As String * 3
    ghVersion As String * 3
    ghWidth As Integer
    ghHeight As Integer
    ghPacked As Byte
    ghBackground As Byte
    ghAspect As Byte
End Type

Private Type typRGBTriplet
    rgbRed As Byte
    rgbGreen As Byte
    rgbBlue As Byte
End Type

' Member variables
Dim m_FileName As String
Dim m_FileSize As Long
Dim m_Version As String * 3
Dim m_Width As Long
Dim m_Height As Long
Dim m_Background As Byte
Dim m_Aspect As Single
Dim m_BitDepth As Byte
Dim m_HasGlobalColourTable As Boolean
Dim m_IsTerminated As Boolean

Dim Palette() As typRGBTriplet
Dim PalSize As Integer

Private Const GIFSig As String = "GIF"
Private Const GIFTerminator As Byte = &H3B

' Public interface to member variables
Public Property Get FileName() As String
    FileName = m_FileName
End Property

Public Property Get FileSize() As Long
    FileSize = m_FileSize
End Property

Public Property Get Version() As String
    Version = m_Version
End Property

Public Property Get Width() As Long
    Width = m_Width
End Property

Public Property Get Height() As Long
    Height = m_Height
End Property

Public Property Get Background() As Byte
    Background = m_Background
End Property

Public Property Get Aspect() As Single
    Aspect = m_Aspect
End Property

Public Property Get BitDepth() As Byte
    BitDepth = m_BitDepth
End Property

Public Property Get HasGlobalColourTable() As Boolean
    HasGlobalColourTable = m_HasGlobalColourTable
End Property

Public Property Get IsTerminated() As Boolean
    IsTerminated = m_IsTerminated
End Property

' Public methods
Public Function ReadFile(ByRef inPath As String) As Boolean
    Dim FileSize As Long
    Dim FNum As Integer
    Dim TempHeader As typGIFHeader
    Dim ReadPal As Long
    Dim TempByte As Byte
    
    Call ClearInfo
    
    On Error Resume Next
    FileSize = FileLen(inPath)
    On Error GoTo 0
    
    If (FileSize < 13) Then Exit Function
    
    FNum = FreeFile()
    Open inPath For Binary Access Read Lock Write As #FNum
        Get #FNum, , TempHeader
        
        ' Check signature
        If (TempHeader.ghSignitare <> GIFSig) Then
            Close #FNum
            Exit Function
        End If
        
        With TempHeader ' Extract information
            m_FileName = inPath
            m_FileSize = FileSize
            m_Version = .ghVersion
            m_Width = SWordToUWord(.ghWidth)
            m_Height = SWordToUWord(.ghHeight)
            m_Background = .ghBackground
            m_Aspect = IIf(.ghAspect, ((.ghAspect + 15) / 64), 0)
            m_BitDepth = ((.ghPacked \ &H10) And &H7) + 1
            m_HasGlobalColourTable = ((.ghPacked \ &H80) And &H1) = &H1
        End With
        
        If (m_HasGlobalColourTable) Then ' Read palette
            PalSize = 2 ^ ((TempHeader.ghPacked And &H7) + 1)
            ReDim Palette(PalSize - 1) As typRGBTriplet
            
            For ReadPal = 0 To PalSize - 1
                Get #FNum, , Palette(ReadPal)
            Next ReadPal
        End If
        
        ' Skip to the end of the file and read in last byte to check for image terminator (";")
        Seek #FNum, FileSize
        Get #FNum, , TempByte
        m_IsTerminated = TempByte = GIFTerminator
    Close #FNum
    
    ' That's all there is to it!
    ReadFile = True
End Function

Public Function GetPalEntry(ByVal inIndex As Byte) As Long
    If (inIndex < PalSize) Then GetPalEntry = RGB( _
        Palette(inIndex).rgbRed, _
        Palette(inIndex).rgbGreen, _
        Palette(inIndex).rgbBlue) _
    Else GetPalEntry = -1
End Function

' Private methods
Private Sub ClearInfo()
    m_FileName = ""
    m_FileSize = 0
    m_Version = ""
    m_Width = 0
    m_Height = 0
    m_Background = 0
    m_Aspect = 0
    m_BitDepth = 0
    m_HasGlobalColourTable = False
    m_IsTerminated = False
    PalSize = 0
End Sub

Private Function SWordToUWord(ByVal inWord As Integer) As Long
    Call RtlMoveMemory(ByVal VarPtr(SWordToUWord), ByVal VarPtr(inWord), &H2)
End Function