VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "BMP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type BitMapFileHeader
  FileType           As String * 2 '="BM"
  FileSize           As Long     'number of bytes in file
  xHotSpot           As Integer  '0
  yHotSpot           As Integer  '0
  OffsetToBits       As Long     'byte offset in file where image begins
End Type

Private Type RGBQuad
  Blue  As Byte 'blue value for color map entry
  Green As Byte 'green value for color map entry
  Red   As Byte 'red value for color map entry
  Zero  As Byte '=0
End Type

Private Type BitMapHeader
  BitMapHeaderSize   As Long     'size of this structure = 40 bytes
  ImageWidth         As Long     'image width in pixels
  ImageHeight        As Long     'image height in pixels
  NumBitPlanes       As Integer  'number of image planes = 1
  NumBitsPerPlane    As Integer  'bits per pixel = 1, 4, 8, or 24
  CompressionScheme  As Long
  SizeOfImageData    As Long     'size in bytes of compressed image or 0 if uncompressed
  XResolution        As Long     'pixels/meter
  YResolution        As Long     'pixels/meter
  NumColorsUsed      As Long     '=2 for black(0) and white(1)
  NumImportantColors As Long
End Type

Dim lFileName As String
Dim FileHeader As BitMapFileHeader
Dim Header As BitMapHeader
Dim TheBytes() As Byte
Dim ImageSize As Long
Dim Colors() As RGBQuad

Public Function ReadFile() As Boolean
Dim FileNum As Integer
Dim aColor As RGBQuad
  FileNum = FreeFile                                      'assign a file number
  Open lFileName For Binary As #FileNum                    'open the file
  Get #FileNum, 1, FileHeader                             'read the file header
  If FileHeader.FileType = "BM" Then                      'make sure it's a BMP
    ReadFile = True
    Get #FileNum, 1 + Len(FileHeader), Header             'read the image header
    If Header.BitMapHeaderSize <= 12 Then                 'don't process old 16-bit forms
      ReadFile = False
    Else                                                  'process 32-bit form
      ReDim Colors(Header.NumColorsUsed - 1) As RGBQuad
      Get #FileNum, 1 + Len(FileHeader) + Len(Header), Colors 'read the colors
                                                              'calc. size of image
      ImageSize = FileHeader.FileSize - Len(FileHeader) - Len(Header) - (Header.NumColorsUsed * Len(aColor))
      ReDim TheBytes(1 To ImageSize) As Byte
      Get #FileNum, 1 + FileHeader.OffsetToBits, TheBytes 'read the image
    End If
  Else                                                    'not a BMP
    ReadFile = False
  End If
  Close #FileNum                                          'close the file
End Function

Private Sub Class_Initialize()
  ImageSize = -1
End Sub

Public Property Let FileName(ByVal NewFileName As String)
    lFileName = NewFileName
End Property

Public Property Get Size() As Variant
  If ImageSize > 0 Then Size = ImageSize Else Size = 0
End Property

Public Property Get Height() As Variant
  If ImageSize > 0 Then Height = Header.ImageHeight Else Height = 0
End Property

Public Property Get width() As Variant
  If ImageSize > 0 Then width = ImageSize / Header.ImageHeight Else width = 0
End Property

Public Sub GetImage(Image())
Dim i As Long
  If ImageSize > 0 Then
    For i = 1 To ImageSize
      Image(i) = TheBytes(i)
    Next 'I
  Else
  End If
End Sub

Public Property Get ColorsUsed() As Variant
  If ImageSize > 0 Then ColorsUsed = Header.NumColorsUsed Else ColorsUsed = 0
End Property

Public Property Get ColorTable() As Variant
Dim i As Long
Dim J As Long
Dim aColor As RGBQuad
  If ImageSize > 0 Then
    J = 0
    For i = 0 To Header.NumColorsUsed - 1
      aColor = Colors(i)
      ColorTable(J) = aColor.Red
      ColorTable(J + 1) = aColor.Green
      ColorTable(J + 2) = aColor.Blue
      ColorTable(J + 3) = aColor.Zero
      J = J + 4
    Next 'I
  Else
  End If
End Property