How to read a gif file header? 
Author Message
 How to read a gif file header?

Hi,

Please provide code for VB 6 to read a gif file header.

Thanks for your help and time.

Guy



Thu, 01 Jul 2004 09:29:27 GMT  
 How to read a gif file header?
Hi

Please note that the image decompression code DOSENT WORK! So remove it.

HTH

Max Bolingbroke

============================================
'Put this on a form
Private Type RGB
    Red As Integer
    Green As Integer
    Blue As Integer
End Type

Private Type ImageDescriptor
    ImageLeftJustification As Long
    ImageTopJustification As Long
    ImageWidth As Long
    ImageHeight As Long
    UseGlobalColourMap As Boolean
    Pixel As Long
    Interlaced As Boolean
    LocalColourMap() As RGB
    RasterData As String
End Type

Private Type GIF
    Signature As String
    ScreenWidth As Long
    ScreenHeight As Long
    ColourMapAfterDescriptor As Boolean
    ColourResolution As Long
    BitsPerPixel As Long
    ScreenBackGround As Long
    GlobalColourMap() As RGB
    ImageDescriptors() As ImageDescriptor
    Raw As String
End Type

Private Sub cmdLoad_Click()

    Dim a As Long
    Dim b As Long

    Dim GifData As String
    Dim gCount As Integer
    Dim MyPixel As Long
    Dim PixColour As Long
    Dim MyGif As GIF
    Dim Binary As New clsBinary

    Dim Temp(1) As String

    Open txtPath.Text For Binary As #1
        GifData = String(FileLen(txtPath.Text), Chr(0))
        Get #1, , GifData
    Close #1

    MyGif.Raw = GifData
    MyGif.Signature = Left(GifData, 6)

    GifData = Mid(GifData, 7)

    Temp(0) = Left(GifData, 1)
    Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)
    Temp(0) = Mid(GifData, 2, 1)
    Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8) & Temp(1)

    MyGif.ScreenWidth = Binary.ToNumber(Temp(1))

    GifData = Mid(GifData, 3)

    Temp(0) = Left(GifData, 1)
    Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)
    Temp(0) = Mid(GifData, 2, 1)
    Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8) & Temp(1)

    MyGif.ScreenHeight = Binary.ToNumber(Temp(1))

    GifData = Mid(GifData, 3)

    Temp(0) = Left(GifData, 1)
    Temp(0) = Binary.ToBinary(Asc(Temp(0)), 8)

    MyGif.ColourMapAfterDescriptor = CBool(Mid(Temp(0), 1, 1))

    Temp(1) = Mid(Temp(0), 2, 3)

    MyGif.ColourResolution = Binary.ToNumber(Temp(1)) + 1

    Temp(1) = Mid(Temp(0), 6, 3)

    MyGif.BitsPerPixel = Binary.ToNumber(Temp(1)) + 1

    GifData = Mid(GifData, 2)

    MyGif.ScreenBackGround = Asc(Left(GifData, 1))

    'End of segment, get next data chunk
    GifData = Mid(GifData, 3)

    If MyGif.ColourMapAfterDescriptor = True Then
        'Global colour map
        'No of entries = 2**(# bits per pixel)
        Temp(0) = 2 ^ MyGif.BitsPerPixel
        'Format R G B (repeat)
        For a = 0 To Temp(0)
            ReDim Preserve MyGif.GlobalColourMap(gCount)
            MyGif.GlobalColourMap(gCount).Red = Asc(Mid(GifData, (a * 3) +
1, 1))
            MyGif.GlobalColourMap(gCount).Green = Asc(Mid(GifData, (a * 3) +
2, 1))
            MyGif.GlobalColourMap(gCount).Blue = Asc(Mid(GifData, (a * 3) +
3, 1))
            gCount = gCount + 1
        Next a
        GifData = Mid(GifData, (Temp(0) * 3) + 1)
    End If

    gCount = 0
    Do While Left(GifData, 1) = "," Or Left(GifData, 1) = "!"
        If Left(GifData, 1) = "!" Then
            'Gif extension block - read past
            GifData = Mid(GifData, InStr(1, GifData, Chr(0)) + 1)
        Else
            'Image descriptor
            ReDim Preserve MyGif.ImageDescriptors(gCount)

            GifData = Mid(GifData, 2)

            Temp(0) = Left(GifData, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)
            Temp(0) = Mid(GifData, 2, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8) & Temp(1)

            MyGif.ImageDescriptors(gCount).ImageLeftJustification =
Binary.ToNumber(Temp(1))

            GifData = Mid(GifData, 3)

            Temp(0) = Left(GifData, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)
            Temp(0) = Mid(GifData, 2, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8) & Temp(1)

            MyGif.ImageDescriptors(gCount).ImageTopJustification =
Binary.ToNumber(Temp(1))

            GifData = Mid(GifData, 3)

            Temp(0) = Left(GifData, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)
            Temp(0) = Mid(GifData, 2, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8) & Temp(1)

            MyGif.ImageDescriptors(gCount).ImageWidth =
Binary.ToNumber(Temp(1))

            GifData = Mid(GifData, 3)

            Temp(0) = Left(GifData, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)
            Temp(0) = Mid(GifData, 2, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8) & Temp(1)

            MyGif.ImageDescriptors(gCount).ImageHeight =
Binary.ToNumber(Temp(1))

            GifData = Mid(GifData, 3)

            'Get flags bit
            Temp(0) = Left(GifData, 1)
            Temp(1) = Binary.ToBinary(Asc(Temp(0)), 8)

            MyGif.ImageDescriptors(gCount).UseGlobalColourMap = Not
CBool(Mid(Temp(1), 1, 1))
            MyGif.ImageDescriptors(gCount).Interlaced = CBool(Mid(Temp(1),
2, 1))
            MyGif.ImageDescriptors(gCount).Pixel =
Binary.ToNumber(Mid(GifData, 6, 3))

            GifData = Mid(GifData, 2)

            If MyGif.ImageDescriptors(gCount).UseGlobalColourMap = False
Then
                'Get local colour map
                'As yet unknown
            End If

            'Raster data of image
            RasterData = Mid(GifData, 1,
MyGif.ImageDescriptors(gCount).ImageWidth *
MyGif.ImageDescriptors(gCount).ImageHeight)

            MyGif.ImageDescriptors(gCount).RasterData = RasterData

            'Now decompress data
            'Maybe
            MyGif.ImageDescriptors(gCount).RasterData =
modLZW.DeCompress(MyGif.ImageDescriptors(gCount).RasterData)

            RasterData = MyGif.ImageDescriptors(gCount).RasterData

            OneWidth = (picGif.Width /
MyGif.ImageDescriptors(gCount).ImageWidth) ' * Screen.TwipsPerPixelX
            OneHeight = (picGif.Height /
MyGif.ImageDescriptors(gCount).ImageHeight) ' * Screen.TwipsPerPixelY

            For a = 1 To MyGif.ImageDescriptors(gCount).ImageWidth
                For b = 1 To MyGif.ImageDescriptors(gCount).ImageHeight
                    CurrPixel = CurrPixel + 1
                    Entry = Asc(Mid(RasterData, CurrPixel, 1))
                    If MyGif.ImageDescriptors(gCount).UseGlobalColourMap
Then
                        PixColour = RGB(MyGif.GlobalColourMap(Entry).Red,
MyGif.GlobalColourMap(Entry).Green, MyGif.GlobalColourMap(Entry).Blue)
                    Else
                        PixColour =
RGB(MyGif.ImageDescriptors(gCount).LocalColourMap(Entry).Red,
MyGif.ImageDescriptors(gCount).LocalColourMap(Entry).Green,
MyGif.ImageDescriptors(gCount).LocalColourMap(Entry).Blue)
                    End If
                    Box picGif, OneWidth * (a - 1), OneHeight * (b - 1),
OneWidth * a, OneHeight * b, PixColour
                Next b
            Next a

            GifData = Mid(GifData,
(MyGif.ImageDescriptors(gCount).ImageWidth *
MyGif.ImageDescriptors(gCount).ImageHeight) + 1)

            gCount = gCount + 1
        End If
    Loop

    'End of image!

End Sub

Private Function Box(PicBox As PictureBox, OriginX As Long, OriginY As Long,
EndX As Long, EndY As Long, Colour As Long)

    For a = OriginX To EndX Step Screen.TwipsPerPixelX
        PicBox.Line (a, OriginY)-(a, EndY), Colour, BF
    Next a

End Function

=================================
'Add this to a class module called clsBinary

Public Function ToBinary(ByVal Number As Long, Bits As Integer) As String

    Dim OutPut As String

    Factor = 2 ^ (Bits - 1)

    Do While Factor >= 1
        If Number - Factor >= 0 Then
            Number = Number - Factor
            OutPut = OutPut & "1"
        Else
            OutPut = OutPut & "0"
        End If
        Factor = Factor / 2
    Loop

    ToBinary = OutPut

End Function

Public Function ToNumber(ByVal Binary As String) As Long

    Dim OutPut As Long

    Factor = 2 ^ (Len(Binary) - 1)

    For a = 1 To Len(Binary)
        If Mid(Binary, a, 1) = "1" Then OutPut = OutPut + Factor
        Factor = Factor / 2
    Next a

    ToNumber = OutPut

End Function

Public Function GetValueOfBinaryString(MSBFirst As Boolean, Binary As
String) As Long

    Dim OutPut As Long
    Dim BytesValue() As Long
    Dim CurrByte As Long
    Dim MyBinary As String

    For a = 1 To Len(Binary) / 8 Step 8
        ReDim Preserve BytesValue(CurrByte)
        BytesValue(CurrByte) = ToNumber(Mid(Binary, a, 8))
        CurrByte = CurrByte + 1
    Next a

    If MSBFirst = True Then
        For a = 0 To UBound(CurrByte)
            MyBinary = MyBinary & CurrByte(a)
        Next a
    Else
        For a = UBound(CurrByte) To 0 Step -1
            MyBinary = MyBinary & CurrByte(a)
        Next a
    End If

    OutPut = ToNumber(MyBinary)

    GetValueOfBinaryString = OutPut

End Function

Public Function GetValueOfBytes(MSBFirst As Boolean, Bytes As String) As
Long

    Dim OutPut As Long
    Dim MyBinary As String

    For a = 1 To Len(Bytes)
        MyBinary = MyBinary & ToBinary(Asc(Mid(Bytes, a, 1)))
    Next a

    OutPut = GetValueOfBinaryString(MSBFirst, MyBinary)

    GetValueOfBytes = OutPut

End Function


Quote:
> Hi,

> Please provide code for VB 6 to read a gif file header.

> Thanks for your help and time.

> Guy



Thu, 01 Jul 2004 16:48:54 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. Removing WWW Server HEADERS from download GIF file

2. Reading File Header Info (Binary Files)

3. Reading File Header Info (Binary Files)

4. Reading File Header Info (Binary Files)

5. Save to GIF file from resource GIF file

6. With VB.NET read header info from FoxPro DBF files

7. Reading email headers and writing to a file

8. How do I read the file header

9. Reading file header

10. Trying to Read Header from Excel file

11. Reading WAV Headers of MPEG files

12. How to read Section Headers from .ini file

 

 
Powered by phpBB® Forum Software