CodeItBetter Programming Another VB Programming Blog

'Graphics - How to get BMP file information

Option Explicit
 
'Add a Image Control and a Text Box to your form and set the MultiLine Property of Text Box to True.

Dim BitMapFile As String
Private Const CANCELERR = 32755
Private Const BI_RGB = 0&
Private Const BI_RLE8 = 1&
Private Const BI_RLE4 = 2&
Private Const BI_BITFIELDS = 3&
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type
 
Private Sub Form_Load()
    BitMapFile = "C:\Temp\Test.bmp"
    Dim ff As Integer
    Dim tmp As String
    Dim FileHeader As BITMAPFILEHEADER
    Dim InfoHeader As BITMAPINFOHEADER
    Image1 = LoadPicture(BitMapFile)
    ff = FreeFile
    Open BitMapFile For Binary Access Read As #ff
    Get #ff, , FileHeader
    Get #ff, , InfoHeader
    Close #ff
    Text1.text = "Width: " & InfoHeader.biWidth & " pixels " & "Height: " & InfoHeader.biHeight & " pixels"
    Select Case InfoHeader.biSizeImage
    Case 0
        tmp$ = "BI_RGB bitmap; size variable not filled in."
    Case Else
        tmp$ = Format$(InfoHeader.biSizeImage, "#,###,###") & " bytes"
    End Select
    Text1.text = Text1 & vbCrLf & tmp$ & vbCrLf & InfoHeader.biPlanes & InfoHeader.biBitCount & _
               " (" & 2 ^ InfoHeader.biBitCount & " colours)"
    Select Case InfoHeader.biCompression
    Case BI_RGB
        tmp$ = "Uncompressed bitmap."
    Case BI_RLE8
        tmp$ = "Run-length encoded (RLE) format for bitmaps with 8 bits per pixel."
    Case BI_RLE4
        tmp$ = "Run-length encoded (RLE) format for bitmaps with 4 bits per pixel."
    Case BI_BITFIELDS
        tmp$ = "Uncompressed 16- or 32-bit-per-pixel format."
    End Select
    Text1 = Text1 & vbCrLf & tmp$
    Select Case InfoHeader.biClrUsed
    Case 0
        tmp$ = "Bitmap uses the maximum number of colours corresponding to the"
        tmp$ = tmp$ & " bits-per-pixel for the compression mode."
    Case Is <> 0 And InfoHeader.biBitCount = 16
        tmp$ = "The size of the colour table used to optimize performance"
        tmp$ = tmp$ & "of Windows colour palettes is " & Str$(InfoHeader.biClrUsed)
    End Select
    Text1 = Text1 & vbCrLf & tmp$
    Select Case InfoHeader.biClrImportant
    Case 0
        tmp$ = "All " & 2 ^ InfoHeader.biBitCount & " colour"
        tmp$ = tmp$ & " indices are considered important for displaying this bitmap."
    Case Is <> 0
        tmp$ = "The number of colours that are considered important for displaying"
        tmp$ = tmp$ & " this bitmap are " & Str$(InfoHeader.biClrImportant)
    End Select
    Text1 = Text1 & vbCrLf & tmp$
End Sub