Get BMP And RLE File Info

'Add 1 Image Control and 1 Text Box to your form.
'Set The Text Box MultiLine Property to True.

'Insert the following code to your form:

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()
'Put here the name of yor BMP or RLE file
BitMapFile = "c:\tmp\gradientbar.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

Go Back