VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "PicBMP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' PicInfo bitmap file information class
' ©2006 Aivosto Oy (www.aivosto.com)
'
' This file is part of a sample project for Project Analyzer.
' Distribution of this file is only allowed along with Project Analyzer
' according to the Project Analyzer license terms.

Option Explicit

Implements IPicInfo

Private Enum EBMPType
    bmpUnknown
    bmpInfoHeader
    bmpCoreHeader
End Enum
Private BMPType As EBMPType

Private Type BITMAPFILEHEADER
        bfType As Integer       ' Specifies the file type, must be BM.
        bfSize As Long          ' Specifies the size, in bytes, of the bitmap file.
        bfReserved1 As Integer  ' Reserved; must be zero.
        bfReserved2 As Integer  ' Reserved; must be zero.
        bfOffBits As Long       ' Specifies the offset, in bytes, from the beginning of the BITMAPFILEHEADER structure to the bitmap bits.
End Type
Private Type BITMAPINFOHEADER
        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 BITMAPCOREHEADER
        bcSize As Long
        bcWidth As Integer
        bcHeight As Integer
        bcPlanes As Integer
        bcBitCount As Integer
End Type
Private InfoHeader As BITMAPINFOHEADER
Private CoreHeader As BITMAPCOREHEADER

Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const BI_bitfields = 3&

' IsRLE indicates whether the bitmap is RLE compressed (True) or not (False)
' This variable is written but not read
' It might well be removed without affecting the functionality of the program
Private IsRLE As Boolean

' Filename used in the previous call to ReadFile
Private StoredFilename As String


Private Function ReadBitmapFile(ByVal Filename As String) As Boolean
' Read picture information from a bitmap file of type BMP/DIB/RLE
' [Filename] Name of picture file
' Return value:
' True - Picture information retrieved
' False - Not a valid bitmap file

Dim BMPFileHeader As BITMAPFILEHEADER ' Main BM file header
Dim FileNr As Integer  ' Number of open file
Dim HeaderSize As Long ' Size of header data in bytes

IsRLE = False        ' Clear the IsRLE flag. We will set it below to True if required.
BMPType = bmpUnknown ' Set file type to bmpUnknown until we can verify the real type

' Open the file for binary read access
FileNr = FreeFile
Open Filename For Binary Access Read Lock Write As #FileNr

If LOF(FileNr) > Len(BMPFileHeader) Then
    ' File length is "enough", read main BM file header header
    Get #FileNr, 1, BMPFileHeader
    If BMPFileHeader.bfType = &H4D42 Then ' BM
        If BMPFileHeader.bfReserved1 = 0 And BMPFileHeader.bfReserved2 = 0 Then
            ' Signature OK
        
            ' Retrieve size of following header
            Get #FileNr, , HeaderSize
            Seek #FileNr, Seek(FileNr) - 4 ' Rewind to start of header
            
            Select Case HeaderSize
                Case Len(CoreHeader)
                    Get #FileNr, , CoreHeader
                    BMPType = bmpCoreHeader
                    ReadBitmapFile = True ' File valid
                Case Len(InfoHeader)
                    Get #FileNr, , InfoHeader
                    BMPType = bmpInfoHeader
                    
                    ' Determine bitmap compression
                    Select Case InfoHeader.biCompression
                        Case BI_RLE8, BI_RLE4
                            ' The bitmap is RLE compressed
                            IsRLE = True
                    End Select
                    ReadBitmapFile = True ' File valid
                Case Else
                    ReadBitmapFile = False ' Invalid/unsupported file type
            End Select
        End If
    End If
End If
Close FileNr

End Function


Private Property Get IPicInfo_Filename() As String
' Returns the filename used in the previous call to ReadFile

IPicInfo_Filename = StoredFilename

End Property

Private Property Get IPicInfo_MaxColors() As Variant

Select Case BMPType
    Case bmpCoreHeader
        IPicInfo_MaxColors = 2 ^ CoreHeader.bcBitCount
    Case bmpInfoHeader
        IPicInfo_MaxColors = 2 ^ InfoHeader.biBitCount
End Select


End Property

Private Function IPicInfo_ReadFile(ByVal Filename As String) As Boolean
' Read a picture file to retrieve picture information
' [Filename] File to read
' Return value:
' True - Picture information retrieved
' False - Error, information not retrieved

IPicInfo_ReadFile = ReadBitmapFile(Filename)

End Function


Private Property Get IPicInfo_Size() As TPicSize
' Returns picture width and height in pixels

Select Case BMPType
    Case bmpCoreHeader
        IPicInfo_Size.Width = CoreHeader.bcWidth
        IPicInfo_Size.Height = CoreHeader.bcHeight
    Case bmpInfoHeader
        IPicInfo_Size.Width = InfoHeader.biWidth
        IPicInfo_Size.Height = InfoHeader.biHeight
End Select

End Property


