Into BMP Format creating Excel Art

Once I received an Excel attachment showing a beatiful picture of a village created by coloring the square shaped cells. It would have taken a lot of time to complete the job. It then strike into my mind that a similar Excel Art can also be created by an Application which can take a picture as its source. Since GIF and JPG have complex file formats due to the Compression algorithms used, I though an Uncompressed 24 Bit BMP file would be the best choice. And thus started what you will see below.

I have used http://web.uccs.edu/wbahn/ECE1021/STATIC/REFERENCES/bmpfileformat.htm as reference for BMP File Format. Though Microsoft Excel supports colour defined as RGB, it only supports a limited pallet for colouring the cells and thus the result picture doesnot show up in True Colors.

Let’s start with it. Create a new VB Project.

Add a textBox named “txtFileName”, a button named “cmdOpen” with Caption “Browse…”. Add a “Microsoft Common Dialog Ontrol” dlgOpen.

Add code below to the Click event of cmdOpen

Private Sub cmdOpen_Click()

    dlgOpen.DialogTitle = "Select BMP File to create Excel Art from"
    dlgOpen.DefaultExt = ".dbf"
    dlgOpen.Filter = "BMP Files|*.bmp"

    dlgOpen.ShowOpen

    If dlgOpen.FileName <> "" Then
        txtFileName = dlgOpen.FileName
    End If

End Sub

Create a button cmdExcel captioned “Create Excel Art”. The code that we will discuss later will all come under the Click event for cmdExcel

Private Sub cmdExcel_Click()

End Sub

Add reference to the “Microsoft ActiveX Data Objects Library 2.6″. The filename which we will get as above will be opened using the Stream object of ADODB. The stream type will be declared as Binary type. The data from the file thus will be recieved as a byteArray.

    Dim objADOStream As New ADODB.Stream
    Dim byteArray As Variant

    objADOStream.Type = adTypeBinary
    objADOStream.Open
    objADOStream.LoadFromFile txtFileName
    byteArray = objADOStream.Read

Now that we have received the file content, we will first read the File Header which is 14 bytes long.
First 2 bytes always contain “BM”
Next 4 bytes contain the Size of file in bytes.
Next 4 bytes are reserved and currently unused.
Last 4 bytes show the offset to start of Pixel Data.

The code below will ensure that opened file is a valid BMP and that its actual size and the size in file header match. It will then store the DataOffset for use later.

    Dim lDataOffset As Long

    If Chr(byteArray(0)) & Chr(byteArray(1)) <> "BM" Then
        MsgBox "File is not a BMP File"
        End
    End If

    If (UBound(byteArray) + 1) <> (byteArray(2) + byteArray(3) * 256 + _
              byteArray(4) * 256 * 256 + byteArray(5) * 256 * 256 * 256) Then
        MsgBox "BMP File is Corrupted."
        End
    End If

    lDataOffset = byteArray(10) + byteArray(11) * 256 + byteArray(12) * 256 * 256 + _
                byteArray(13) * 256 * 256 * 256

Next 40 bytes store the Image Header.
The above value “40″ itself is stored in the first 4 bytes of the Image Header.
Next 4 bytes store the Width of Image in Pixels
Next 4 bytes store the Height of Image in Pixels
Next 2 bytes stores number of planes and is always one.
Next 2 bytes store the Color depth “bits per pixel”
The Next four bytes specify the Compression type and is Zero for uncompressed.

Remaining parts of the header is insignificant for this project.

The code below will ensure that our criteria of “Uncompressed 24 bit BMPs” is met and will store Image Width and Height for use later.

One concept to note here is the ScanLine Size. It is the number of bytes that will be required to store the pixel data for each row and is always in multiple of 4. Since for a 24bit BMP each pixel requires 3 bytes a row will take ImageWidth*3 bytes which if is not a multiple of 4 will have extra insignificant bytes added to make it multiple of 4.

    Dim lBMPWidth As Long
    Dim lBMPHeight As Long
    Dim lScanLineSize As Long

    If byteArray(2  + byteArray(29) * 256 <> 24 Then
        MsgBox "Only 24 bit BMPs are supported"
        End
    End If

    If byteArray(30) > 0 Then
        MsgBox "Compressed BMPs are not supported"
        End
    End If

    lBMPWidth = byteArray(1  + byteArray(19) * 256 + byteArray(20) * 256 * 256 + byteArray(21) * 256 * 256 * 256
    lBMPHeight = byteArray(22) + byteArray(23) * 256 + byteArray(24) * 256 * 256 + byteArray(25) * 256 * 256 * 256
    lScanLineSize = Int((lBMPWidth * 3 + 3) / 4) * 4

Now the last part is creating an Instance of Excel, reading the pixel data and coloring the cell of worksheet accordingly. Since the Excel Worksheet cannot have more that 256 columns we will skip reading pixel data if width of image is more that 256. The column width and row height of the cells will be adjusted so that they are visible as Squares. The pixel data is written for the last line first starting from left to write, each of three bytes showing Blue, Green, and Red component resp.

    Dim lCtrY As Long
    Dim lCtrX As Long
    Dim lScanOffset As Long
    Dim lCurWidth As Long

    Dim objExcel As Object
    Dim objWorkbook As Object

    If lBMPWidth > 256 Then
        lCurWidth = 256
    Else
        lCurWidth = lBMPWidth
    End If   

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Set objWorkbook = objExcel.Workbooks.Add

    lScanOffset = lDataOffset
    For lCtrY = lBMPHeight To 1 Step -1
        For lCtrX = 1 To lCurWidth

        objWorkbook.ActiveSheet.Cells(lCtrY, lCtrX).Interior.Color = _
                RGB(byteArray(lScanOffset + lCtrX * 3 - 1), _
                byteArray(lScanOffset + lCtrX * 3 - 2), _
                byteArray(lScanOffset + lCtrX * 3 - 3))
        Next

    lScanOffset = lScanOffset + lScanLineSize

    Next

    With objWorkbook.ActiveSheet.Range(objWorkbook.ActiveSheet.Cells(1, 1), _
            objWorkbook.ActiveSheet.Cells(lBMPHeight, lCurWidth))
        .ColumnWidth = 2
        .RowHeight = 15
        .Borders.Weight = 2
    End With

The Windows Executable Version of Software mentioned plus the source files can be downloaded from http://jha.jalaj.googlepages.com/Excel-Art.zip

Excel Art	The Original Picture

The Windows Executable Version of Software mentioned plus the source files can be downloaded from http://jha.jalaj.googlepages.com/Excel-Art.zip