|
|
![]() |
|
||
|
|
|||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||
| Visual Basic Bitmap Routines Pure VB: Obtaining Bitmap File Info Without APIs |
||
| Posted: | February 27, 1997 | |
| Updated: | Monday December 26, 2011 | |
| Applies to: | VB3, VB4-16, VB4-32, VB5, VB6 | |
| Developed with: | VB4-32, Windows 95 | |
| OS restrictions: | None | |
| Author: | Unknown | |
|
Related: |
BitBlt: Mimicking the PrintScreen Function BitBlt: Mimicking PrintScreen to Create a 'PrintForm' OleCreatePictureIndirect: Mimicking PrintScreen Using OLE |
|
| Prerequisites |
| None. |
|
|
The
Bitmap Info project demonstrates one means of obtaining from a bitmap file on the disk its image information without loading the actual
bitmap.Within a bitmap file are 2 header groupings of information describing the bitmap image in that file. This data is contained in the file's BITMAPFILEHEADER and BITMAPINFOHEADER structures. By using the VB Type to recreate these structures, the details of the bitmap contained in the file can be obtained with a simple binary read of this data. (Note: due to the formatting of the code to allow pasting into VB, the strings used here will necessitate horizontal scrolling of the browser window on displays under 1024x768 full screen.)
|
| BAS Module Code |
| None. |
|
|
| Form Code |
|
|
| To a form add two command buttons (Command1 and Command2) and nine labels (Label1 through Label9) for the results of the demo. The left-hand labels for the descriptions are optional. Also add a image control (Image1) with its Stretch property set to True, and a common dialog control (CommonDialog1). Add the following code: |
|
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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
bfOhFileBits As Long
End Type
Private Sub Form_Load
'initialize the form controls
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption) = ""
Label4.Caption = ""
Label5.Caption = ""
Label6.Caption = ""
Label7.Caption = ""
Label8.Caption = ""
Label9.Caption = "Select a bitmap or RLE file to detail..."
'position the form
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command1_Click()
'create some working variables
Dim hFile as Long
Dim tmp as String
'create the variables to hold the bitmap info
Dim FileHeader As BITMAPFILEHEADER
Dim InfoHeader As BITMAPINFOHEADER
On Error GoTo FileErrorHandler
'show the common dialog
CommonDialog1.CancelError = True
CommonDialog1.ShowOpen
'display a rendition of the loaded bitmap
Image1 = LoadPicture((CommonDialog1.filename))
Image1.ZOrder 1
'read the file header info
hFile = FreeFile
Open CommonDialog1.filename For Binary Access Read As #hFile
Get #hFile, , FileHeader
Get #hFile, , InfoHeader
Close #hFile
'display the file info
Label9.Caption = CommonDialog1.filename
Label1.Caption = InfoHeader.biWidth & " pixels"
Label2.Caption = 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
Label3.Caption = tmp
Label4.Caption = InfoHeader.biPlanes
Label5.Caption = 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 = "RLE for bitmaps with 8 bits per pixel."
Case BI_RLE4: tmp = "RLE for bitmaps with 4 bits per pixel."
Case BI_BITFIELDS: tmp = "Uncompressed 16- or 32-bit-per-pixel format."
End Select
Label6.Caption = 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"
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
Label7.Caption = tmp
'select the appropriate string based on the value of biClrImportant
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
Label8Caption = tmp
Exit Sub
'handle file errors or the user choosing cancel
FileErrorHandler:
If Err <> CANCELERR Then MsgBox Error$(Err), 48, "Image Info"
lblFileName = "No file was selected."
End Sub |
| Comments |
| Run the project and select a bitmap file. The bitmap statistics will be displayed. |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
![]() |