BitMapInfo

Private Sub cmdEnd_Click()
    Unload Me
    End
End Sub

Private Sub cmdSelect_Click()
    'crea le variabili
    Dim ff as Integer
    Dim tmp as String
    
    'variabili info vecchie bitmap
    Dim FileHeader As BITMAPFILEHEADER
    Dim InfoHeader As BITMAPINFOHEADER
    On Error Goto cmdSelect_FileErrorHandler
    
    'show common dialog
    CMDialog1.CancelError = True
    CMDialog1.ShowOpen
    'visualizza la bitmap caricata
    Image1 = LoadPicture((CMDialog1.filename))
    Image1.ZOrder 1
    'carica il file header info
    ff = FreeFile
    Open CMDialog1.filename For Binary Access Read As #ff
    Get #ff, , FileHeader
    Get #ff, , InfoHeader
    Close #ff
    
    visuaizza il file info
    lblFileName = CMDialog1.filename
    
    lblInfo(0) = InfoHeader.biWidth & " pixels"
    lblInfo(1) = 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
    lblInfo(2) = tmp$
    lblInfo(3) = InfoHeader.biPlanes
    lblInfo(4) = 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
    lblInfo(5) = tmp$
    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 actual number of colours the graphics " & _
                "engine or device driver accesses is " & Str$(InfoHeader.biClrUsed)"
        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 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 error o l'utente ha premuto esc
    cmdSelect_FileErrorHandler:
    
    If Err <> CANCELERR Then MsgBox Error$(Err), 48, "Image Info"
    lblFileName = "No file was selected."
End Sub

'Assumes:By Randy Birch. 
Add an array of labels called lblInfo(0)--lblInfo(7). 
Add labels before them that say:
width,height,image size, planes, bits per pixel, 
compression,colors used,colors important.
Also 
add 2 command buttons called:
cmdEnd and cmdSelect and label them End and select.

'Windows API/Global Declarations for :BitmapInfo

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
biSizeAs Long
biWidthAs Long
biHeight As Long
biPlanes As Integer
biBitCountAs Integer
biCompression As Long
biSizeImageAs Long
biXPelsPerMeterAs Long
biYPelsPerMeterAs Long
biClrUsed As Long
biClrImportantAs Long
End Type
Private Type BITMAPFILEHEADER
bfTypeAs Integer
bfSizeAs Long
bfReserved1As Integer
bfReserved2As Integer
bfOffBits As Long
End Type
'Aggiungere questo codice in un Form

Private Sub Form_Load
'inizializza i controlli nel form

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) = ""

'posiziona il 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()
'crea le variabili

Dim ff as Integer
Dim tmp as String

'variabili info vecchie bitmap

Dim FileHeader As BITMAPFILEHEADER
Dim InfoHeader As BITMAPINFOHEADER
On Error Goto cmdSelect_FileErrorHandler

'show common dialog

CMDialog1.CancelError = True
CMDialog1.ShowOpen
'visualizza la bitmap caricata

Image1 = LoadPicture((CMDialog1.filename))
Image1.ZOrder 1
'carica il file header info

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

visuaizza il file info
lblFileName = CMDialog1.filename

lblInfo(0) = InfoHeader.biWidth & " pixels"
lblInfo(1) = 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
lblInfo(2) = tmp$
lblInfo(3) = InfoHeader.biPlanes
lblInfo(4) = 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
lblInfo(5) = tmp$
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 actual number of colours the graphics " & _
"engine or device driver accesses is " & Str$(InfoHeader.biClrUsed)"
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 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 error o l'utente ha premuto esc

cmdSelect_FileErrorHandler:

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

'Assumes:By Randy Birch.

Add an array of labels called lblInfo(0)--lblInfo(7).
Add labels before them that say:
width,height,image size, planes, bits per pixel,
compression,colors used,colors important.
Also
add 2 command buttons called:
cmdEnd and cmdSelect and label them End and select.