InfoBMPApi

Option Explicit

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 '40 bytes
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

Add the following code into the form:

Private Sub Form_Load

'initialize the form controls

lblFileName = "Select a bitmap or RLE file to detail..."
lblInfo(0) = ""
lblInfo(1) = ""
lblInfo(2) = ""
lblInfo(3) = ""
lblInfo(4) = ""
lblInfo(5) = ""
lblInfo(6) = ""
lblInfo(7) = ""

'position the form

Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

End Sub

Private Sub cmdEnd_Click()

Unload Me
End

End Sub

Private Sub cmdSelect_Click()

'create some working variables

Dim ff as Integer
Dim tmp as String

'create the variables to hold the bitmap info

Dim FileHeader As BITMAPFILEHEADER
Dim InfoHeader As BITMAPINFOHEADER

On Error GoTo cmdSelect_FileErrorHandler

'show the common dialog

CMDialog1.CancelError = True
CMDialog1.ShowOpen

'display a rendition of the loaded bitmap

Image1 = LoadPicture((CMDialog1.filename))
Image1.ZOrder 1

'read the file header info

ff = FreeFile
Open CMDialog1.filename For Binary Access Read As #ff
Get #ff, , FileHeader
Get #ff, , InfoHeader
Close #ff

'display the file info

lblFileName = CMDialog1.filename

lblInfo(0) = InfoHeader.biWidth & " pixels"
lblInfo(1) = InfoHeader.biHeight & " pixels"

'select the appropriate string based on the value of biCompression

Select Case InfoHeader.biSizeImage
Case 0: tmp$ = "BI_RGB bitmap; size variable not filled in."
Case Else: tmp$ = Format$(InfoHeader.biSizeImage, "#,###,###") & " bytes"
End Select
lblInfo(2) = tmp$

lblInfo(3) = InfoHeader.biPlanes
lblInfo(4) = InfoHeader.biBitCount & " (" & 2 ^ InfoHeader.biBitCount & " colours)"

'select the appropriate string based on the value of biCompression

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
lblInfo(5) = tmp$

'select the appropriate string based on the value of biClrUsed

Select Case InfoHeader.biClrUsed
Case 0:
tmp$ = "Bitmap uses the maximum number of colours corresponding to the 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 of Windows colour palettes is " & Str$(InfoHeader.biClrUsed)
End Select
lblInfo(6) = tmp$

'select the appropriate string based on the value of biClrImportant

Select Case InfoHeader.biClrImportant
Case 0:
tmp$ = "All " & 2 ^ InfoHeader.biBitCount & " colour indices are considered important for displaying this bitmap."
Case Is <> 0
tmp$ = "The number of colours that are considered important for displaying this bitmap are " & Str$(InfoHeader.biClrImportant)
End Select
lblInfo(7) = tmp$

Exit Sub

'handle file errors or the user choosing cancel

cmdSelect_FileErrorHandler:

If Err <> CANCELERR Then MsgBox Error$(Err), 48, "Image Info"
lblFileName = "No file was selected."

End Sub