Attribute VB_Name = "modBMP"
'***********************************************************************
' Written by: Robert M. Erickson        email: Robert.Erickson@uvm.edu
'
' Bitmap file structures and code to save a bmp file. files are all saved
' as binary files.
'
' FILE HEADER
' BITMAP HEADER
' COLOR PALETTE
' BITMAP DATA
'
'***********************************************************************
Option Explicit

'I have these 2 files saved so i can just open them to set the values
'you can use notepad to view these ascii text files
Global Const gstrBMPFILEDATA As String = "Data\BMP_Image_Header_Data.bny"
Global Const gstrBMPPALETTE As String = "Data\BMP_Palette.bny"

'file header, total 14 bytes
Type winBMPFileHeader
     strFileType As String * 2 ' file type always 4D42h or "BM"
     lngFileSize As Long       'size in bytes ussually 0 for uncompressed
     bytReserved1 As Integer   ' always 0
     bytReserved2 As Integer   ' always 0
     lngBitmapOffset As Long   'starting position of image data in bytes
End Type


'image header, total 40 bytes
Type BITMAPINFOHEADER
     biSize As Long          'Size of this header
     biWidth As Long         'width of your image
     biHeight As Long        'height of your image
     biPlanes As Integer     'always 1
     byBitCount As Integer   'number of bits per pixel 1, 4, 8, or 24
     biCompression As Long   '0 data is not compressed
     biSizeImage As Long     'size of bitmap in bytes, typicaly 0 when uncompressed
     biXPelsPerMeter As Long 'preferred resolution in pixels per meter
     biYPelsPerMeter As Long 'preferred resolution in pixels per meter
     biClrUsed As Long       'number of colors that are actually used (can be 0)
     biClrImportant As Long  'which color is most important (0 means all of them)
End Type

'palette, 4 bytes * 256 = 1024
Type BITMAPPalette
     lngBlue As Byte
     lngGreen As Byte
     lngRed As Byte
     lngReserved As Byte
End Type


'*************************************************************************
' Create a bmp file using the header and palette information previously
' saved in seperate files. the image data comes from a raster file which
' holds the palette index number for each data point.
'*************************************************************************
Public Sub pCreateBMPImage(pstrPaletteFile As String, _
                            pstrRawData As String, _
                            pstrImageName)
          
Dim BMPHeader As winBMPFileHeader
Dim BMPInfo As BITMAPINFOHEADER
Dim BMPPalette As BITMAPPalette

Dim pbytColor As Byte

Dim pdblCounter As Double
          
On Error GoTo ErrorHandler
     Open pstrImageName For Binary As #2
     
     'assign values
     BMPHeader.strFileType = "BM"
     BMPHeader.lngFileSize = 0
     BMPHeader.bytReserved1 = 0
     BMPHeader.bytReserved2 = 0
     BMPHeader.lngBitmapOffset = 1078
     
     BMPInfo.biSize = 40
     BMPInfo.biWidth = 10
     BMPInfo.biHeight = 10
     BMPInfo.biPlanes = 1
     BMPInfo.byBitCount = 8
     BMPInfo.biCompression = 0
     BMPInfo.biSizeImage = 0
     BMPInfo.biXPelsPerMeter = 3780
     BMPInfo.biYPelsPerMeter = 3780
     BMPInfo.biClrUsed = 0
     BMPInfo.biClrImportant = 0
          
     'save file header
     Put #2, , BMPHeader
     
     'save info header
     Put #2, , BMPInfo
          
     'it is easier for me to open the pallette file up seperately
     'the data stored in the file is 4 bytes (red, green, blue,
     'reserved) 256 times. I do have a seperate program to edit a
     'pallette file.
     'get a palette and save the palette in this new file
     Open fstrFileName(pstrPaletteFile) For Binary As #3
     
     For pdblCounter = 1 To (BMPHeader.lngBitmapOffset - 54) / Len(BMPPalette)
          Get #3, , BMPPalette
          Put #2, , BMPPalette
     Next pdblCounter

     Close #3
     
     'The raw data file contains a value for each pixel. the value corresponds
     'to the index number for the palette entry. This is the raw data I used to make
     'this image.
     Dim rawData(10, 10) As Byte
     Dim intColumn As Integer, intRow As Integer
     Open fstrFileName(pstrRawData) For Input As #4
     
    'Fill array with raw data
    For intRow = 1 To 10
        For intColumn = 1 To 10
            Input #4, rawData(intColumn, intRow)
        Next intColumn
    Next intRow
    
    pdblCounter = 0
    'you need to write the rows from the bottom up
    For intRow = 10 To 1 Step -1
        For intColumn = 1 To 10
          
          Put #2, , rawData(intColumn, intRow)
          
          pdblCounter = pdblCounter + 1
          
          'each row of data must be divisible by 4, if not you need to pad the row.
          If pdblCounter = BMPInfo.biWidth Then
               If BMPInfo.biWidth \ 4 <> 0 Then
                    
                    For pdblCounter = 1 To BMPInfo.biWidth Mod 4
                         pbytColor = 0
                         Put #2, , pbytColor
                    Next pdblCounter
                    
                    pdblCounter = 0
               
               End If
          End If
        Next intColumn
     Next intRow
     
     Close
     
Exit Sub

ErrorHandler:
     Call pDisplayError(vbOKOnly, "Error in pCreateBMPImage")
     Close
End Sub