PicBMP.cls

   1 ' PicInfo bitmap file information class
   2 ' 2006 Aivosto Oy (www.aivosto.com)
   3 '
   4 ' This file is part of a sample project for Project Analyzer.
   5 ' Distribution of this file is only allowed along with Project Analyzer
   6 ' according to the Project Analyzer license terms.
   7 
   8 Option Explicit
   9 
  10 Implements IPicInfo
  11 
  12 Private Enum EBMPType
  13     bmpUnknown
  14     bmpInfoHeader
  15     bmpCoreHeader
  16 End Enum
  17 Private BMPType As EBMPType
  18 
  19 Private Type BITMAPFILEHEADER
  20         bfType As Integer       ' Specifies the file type, must be BM.

   ! Type field written, not read: BITMAPFILEHEADER.bfSize - 0 reads, 1 write
  21         bfSize As Long          ' Specifies the size, in bytes, of the bitmap file.
  22         bfReserved1 As Integer  ' Reserved; must be zero.
  23         bfReserved2 As Integer  ' Reserved; must be zero.

   ! Type field written, not read: BITMAPFILEHEADER.bfOffBits - 0 reads, 1 write
  24         bfOffBits As Long       ' Specifies the offset, in bytes, from the beginning of the BITMAPFILEHEADER structure to the bitmap bits.

    Too many uncommented lines: 27
  25 End Type
  26 Private Type BITMAPINFOHEADER

   ! Type field written, not read: BITMAPINFOHEADER.biSize - 0 reads, 1 write
  27         biSize As Long
  28         biWidth As Long
  29         biHeight As Long

   ! Type field written, not read: BITMAPINFOHEADER.biPlanes - 0 reads, 1 write
  30         biPlanes As Integer
  31         biBitCount As Integer
  32         biCompression As Long

   ! Type field written, not read: BITMAPINFOHEADER.biSizeImage - 0 reads, 1 write
  33         biSizeImage As Long

   ! Type field written, not read: BITMAPINFOHEADER.biXPelsPerMeter - 0 reads, 1 write
  34         biXPelsPerMeter As Long

   ! Type field written, not read: BITMAPINFOHEADER.biYPelsPerMeter - 0 reads, 1 write
  35         biYPelsPerMeter As Long

   ! Type field written, not read: BITMAPINFOHEADER.biClrUsed - 0 reads, 1 write
  36         biClrUsed As Long

   ! Type field written, not read: BITMAPINFOHEADER.biClrImportant - 0 reads, 1 write
  37         biClrImportant As Long
  38 End Type
  39 Private Type BITMAPCOREHEADER

   ! Type field written, not read: BITMAPCOREHEADER.bcSize - 0 reads, 1 write
  40         bcSize As Long
  41         bcWidth As Integer
  42         bcHeight As Integer

   ! Type field written, not read: BITMAPCOREHEADER.bcPlanes - 0 reads, 1 write
  43         bcPlanes As Integer
  44         bcBitCount As Integer
  45 End Type
  46 Private InfoHeader As BITMAPINFOHEADER
  47 Private CoreHeader As BITMAPCOREHEADER
  48 

   ! Dead constant: BI_RGB
  49 Private Const BI_RGB = 0&
  50 Private Const BI_RLE4 = 2&
  51 Private Const BI_RLE8 = 1&

   ! Dead constant: BI_bitfields
  52 Private Const BI_bitfields = 3&
  53 
  54 ' IsRLE indicates whether the bitmap is RLE compressed (True) or not (False)
  55 ' This variable is written but not read
  56 ' It might well be removed without affecting the functionality of the program

   ! Variable written, not read: IsRLE - 0 reads, 2 writes
  57 Private IsRLE As Boolean
  58 
  59 ' Filename used in the previous call to ReadFile

   ! Variable read, not written: StoredFilename - 1 read, 0 writes
  60 Private StoredFilename As String
  61 
  62 
  63 Private Function ReadBitmapFile(ByVal Filename As String) As Boolean
  64 ' Read picture information from a bitmap file of type BMP/DIB/RLE
  65 ' [Filename] Name of picture file
  66 ' Return value:
  67 ' True - Picture information retrieved
  68 ' False - Not a valid bitmap file
  69 
  70 Dim BMPFileHeader As BITMAPFILEHEADER ' Main BM file header
  71 Dim FileNr As Integer  ' Number of open file
  72 Dim HeaderSize As Long ' Size of header data in bytes
  73 
  74 IsRLE = False        ' Clear the IsRLE flag. We will set it below to True if required.
  75 BMPType = bmpUnknown ' Set file type to bmpUnknown until we can verify the real type
  76 
  77 ' Open the file for binary read access
  78 FileNr = FreeFile
  79 Open Filename For Binary Access Read Lock Write As #FileNr
  80 
  81 If LOF(FileNr) > Len(BMPFileHeader) Then
  82     ' File length is "enough", read main BM file header header
  83     Get #FileNr, 1, BMPFileHeader
  84     If BMPFileHeader.bfType = &H4D42 Then ' BM
  85         If BMPFileHeader.bfReserved1 = 0 And BMPFileHeader.bfReserved2 = 0 Then
  86             ' Signature OK
  87         
  88             ' Retrieve size of following header
  89             Get #FileNr, , HeaderSize
  90             Seek #FileNr, Seek(FileNr) - 4 ' Rewind to start of header
  91             
  92             Select Case HeaderSize
  93                 Case Len(CoreHeader)
  94                     Get #FileNr, , CoreHeader
  95                     BMPType = bmpCoreHeader
  96                     ReadBitmapFile = True ' File valid
  97                 Case Len(InfoHeader)
  98                     Get #FileNr, , InfoHeader
  99                     BMPType = bmpInfoHeader
 100                     
 101                     ' Determine bitmap compression
 102                     Select Case InfoHeader.biCompression
 103                         Case BI_RLE8, BI_RLE4
 104                             ' The bitmap is RLE compressed
 105                             IsRLE = True
 106                     End Select
 107                     ReadBitmapFile = True ' File valid
 108                 Case Else
 109                     ReadBitmapFile = False ' Invalid/unsupported file type
 110             End Select
 111         End If
 112     End If
 113 End If
 114 Close FileNr
 115 
 116 End Function
 117 
 118 
 119 Private Property Get IPicInfo_Filename() As String
 120 ' Returns the filename used in the previous call to ReadFile
 121 
 122 IPicInfo_Filename = StoredFilename
 123 
 124 End Property
 125 
 126 Private Property Get IPicInfo_MaxColors() As Variant
 127 

   ! Case branch(es) missing for Enum - bmpUnknown
 128 Select Case BMPType
 129     Case bmpCoreHeader
 130         IPicInfo_MaxColors = 2 ^ CoreHeader.bcBitCount
 131     Case bmpInfoHeader
 132         IPicInfo_MaxColors = 2 ^ InfoHeader.biBitCount
 133 End Select
 134 
 135 
 136 End Property
 137 
 138 Private Function IPicInfo_ReadFile(ByVal Filename As String) As Boolean
 139 ' Read a picture file to retrieve picture information
 140 ' [Filename] File to read
 141 ' Return value:
 142 ' True - Picture information retrieved
 143 ' False - Error, information not retrieved
 144 
 145 IPicInfo_ReadFile = ReadBitmapFile(Filename)
 146 
 147 End Function
 148 
 149 
 150 Private Property Get IPicInfo_Size() As TPicSize
 151 ' Returns picture width and height in pixels
 152 

   ! Case branch(es) missing for Enum - bmpUnknown
 153 Select Case BMPType
 154     Case bmpCoreHeader
 155         IPicInfo_Size.Width = CoreHeader.bcWidth
 156         IPicInfo_Size.Height = CoreHeader.bcHeight
 157     Case bmpInfoHeader
 158         IPicInfo_Size.Width = InfoHeader.biWidth
 159         IPicInfo_Size.Height = InfoHeader.biHeight
 160 End Select
 161 
 162 End Property
 163 
 164 
 165