VB.NET BMP File Header - PeatSoft



Module BMP

Imports System.IO

    Private Structure BITMAP_FILEHEADER
        Friend Signature As String
        Friend Size As UInt32
        Friend Reserved As UInt32
        Friend BitsOffset As UInt32
    End Structure

    Private Structure BITMAP_INFOHEADER
        Friend HeaderSize As UInt32
        Friend Width As Int32
        Friend Height As Int32
        Friend Planes As UInt16
        Friend BitCount As UInt16
        Friend Compression As UInt32
        Friend SizeImage As UInt32
        Friend PelsPerMeterX As Int32
        Friend PelsPerMeterY As Int32
        Friend ClrUsed As UInt32
        Friend ClrImportant As UInt32
    End Structure

    Private Structure BITMAP_COREHEADER
        Friend Width As UInt16
        Friend Height As UInt16
        Friend Planes As Int16
        Friend BitCount As Int16
    End Structure

    Private BitmapFileHeader As BITMAP_FILEHEADER
    Private reader1 As BinaryReader

    Public Function getBMPHeader(File1 As String) As String

        Dim BitmapInfoHeader As BITMAP_INFOHEADER
        Dim BitmapCoreHeader As BITMAP_COREHEADER
        Dim BMPtype As Integer = 0
        Dim ColorOffset As Long
        Dim ColorCount As Integer
        Dim gByte As Byte
        Dim readError As Boolean = False

        Dim ftext As String = ""
        Dim ttext As String
        Dim ctext As String

        reader1 = New BinaryReader(File.Open(File1, FileMode.Open, IO.FileAccess.Read, FileShare.Read))

        Try
            BitmapFileHeader.Signature = GetLocalString(reader1, 2)
            BitmapFileHeader.Size = reader1.ReadUInt32
            BitmapFileHeader.Reserved = reader1.ReadUInt32
            BitmapFileHeader.BitsOffset = reader1.ReadUInt32
            BitmapInfoHeader.HeaderSize = reader1.ReadUInt32

            If BitmapInfoHeader.HeaderSize = 40 Then
                ftext = "Windows Bitmap" + vbNewLine + vbNewLine
                BitmapInfoHeader.Width = reader1.ReadInt32
                BitmapInfoHeader.Height = reader1.ReadInt32
                BitmapInfoHeader.Planes = reader1.ReadUInt16
                BitmapInfoHeader.BitCount = reader1.ReadUInt16
                BitmapInfoHeader.Compression = reader1.ReadUInt32
                BitmapInfoHeader.SizeImage = reader1.ReadUInt32
                BitmapInfoHeader.PelsPerMeterX = reader1.ReadInt32
                BitmapInfoHeader.PelsPerMeterY = reader1.ReadInt32
                BitmapInfoHeader.ClrUsed = reader1.ReadUInt32
                BitmapInfoHeader.ClrImportant = reader1.ReadUInt32
            Else
                ftext = "OS/2 Bitmap" + vbNewLine + vbNewLine
                BitmapCoreHeader.Width = reader1.ReadUInt16
                BitmapCoreHeader.Height = reader1.ReadUInt16
                BitmapCoreHeader.Planes = reader1.ReadInt16
                BitmapCoreHeader.BitCount = reader1.ReadInt16
                BMPtype = 1
            End If
        Catch
            readError = True
        End Try

        If (BitmapFileHeader.Signature <> "BM" And BitmapFileHeader.Signature <> "BA") Or readError = True Then
            getBMPHeader = "no Bitmap!"
            Exit Function
        End If

        ftext = ftext + "File Size        : " + BitmapFileHeader.Size.ToString
        ftext = ftext + vbNewLine + "Bits Offset      : " + BitmapFileHeader.BitsOffset.ToString + " (&H" + Hex(BitmapFileHeader.BitsOffset) + ")"
        ftext = ftext + vbNewLine + "Header Size      : " + BitmapInfoHeader.HeaderSize.ToString

        If BMPtype = 0 Then
            ftext = ftext + vbNewLine + "Bitmap Size      : " + BitmapInfoHeader.Width.ToString + " x " + BitmapInfoHeader.Height.ToString
            ftext = ftext + vbNewLine + "Planes           : " + BitmapInfoHeader.Planes.ToString
            ttext = "unknown"
            ColorCount = 0
            Select Case BitmapInfoHeader.BitCount
                Case 1
                    ttext = "Mono"
                Case 4
                    ttext = "16"
                    ColorCount = 16
                Case 8
                    ttext = "256"
                    ColorCount = 256
                Case 16
                    ttext = "16-bit"
                Case 24
                    ttext = "24-bit"
                Case 32
                    ttext = "32-bit"
            End Select
            ftext = ftext + vbNewLine + "Color Palette    : " + ttext
            If BitmapInfoHeader.ClrUsed > 0 Then
                ftext = ftext + vbNewLine + "Colors Used      : " + BitmapInfoHeader.ClrUsed.ToString
            End If
            ttext = "all"
            If BitmapInfoHeader.ClrImportant > 0 Then
                ttext = BitmapInfoHeader.ClrImportant.ToString
            End If
            ftext = ftext + vbNewLine + "Colors Important : " + ttext
            Select Case BitmapInfoHeader.Compression
                Case 0
                    ttext = "none"
                Case 1
                    ttext = "RLE 8-bit"
                Case 2
                    ttext = "RLE 4-bit"
                Case 3
                    ttext = "Bitfields"
            End Select
            ftext = ftext + vbNewLine + "Compression      : " + ttext
            ftext = ftext + vbNewLine + "Image Size       : " + BitmapInfoHeader.SizeImage.ToString
            ftext = ftext + vbNewLine + "Horizontal Pixels: " + BitmapInfoHeader.PelsPerMeterX.ToString
            ftext = ftext + vbNewLine + "Vertical Pixels  : " + BitmapInfoHeader.PelsPerMeterY.ToString
        Else
            ftext = ftext + vbNewLine + "Bitmap Size      : " + BitmapCoreHeader.Width.ToString + " x " + BitmapCoreHeader.Height.ToString
            ftext = ftext + vbNewLine + "Planes           : " + BitmapCoreHeader.Planes.ToString
            ttext = "unknown"
            Select Case BitmapCoreHeader.BitCount
                Case 1
                    ttext = "Mono"
                Case 4
                    ttext = "16"
                Case 8
                    ttext = "256"
                Case 16
                    ttext = "16-bit"
                Case 24
                    ttext = "24-bit"
                Case 32
                    ttext = "32-bit"
            End Select
            ftext = ftext + vbNewLine + "Colors Used      : " + ttext
        End If

        ColorOffset = 14 + BitmapInfoHeader.HeaderSize
        If BitmapInfoHeader.Compression = 3 Then
            ColorOffset = ColorOffset + 12
        End If
        ftext = ftext + vbNewLine + vbNewLine + "Color Offset     : " + ColorOffset.ToString + " (&H" + Hex(ColorOffset) + ")" + vbNewLine + vbNewLine

        If ColorCount > 0 Then
            reader1.BaseStream.Position = ColorOffset - 0
            Dim ExColors As Long = ColorCount
            If BitmapInfoHeader.ClrUsed > 0 Then
                ExColors = BitmapInfoHeader.ClrUsed
            End If
            For i = 1 To ExColors
                ctext = ""
                For j = 1 To 4
                    gByte = reader1.ReadByte
                    If j < 4 Then ctext = Space(3 - Len(gByte.ToString)) + gByte.ToString + "  " + ctext
                Next j
                ftext = ftext + ctext + vbNewLine
            Next i
        End If

        reader1.Close()

        getBMPHeader = ftext

    End Function

    Public Function GetLocalString(tReader As BinaryReader, length As Byte) As String

        Dim bits() As Byte
        Dim count As Integer

        ReDim bits(length - 1)
        count = tReader.Read(bits, 0, length)
        GetLocalString = System.Text.ASCIIEncoding.Default.GetString(bits)

    End Function

End Module


      Copyright 2016 PeatSoft