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