Generating a 16 colour bitmap file

A

Archangelos

New Member
Joined
Aug 21, 2017
Messages
49
Hello from Greece,

I am up to creating images from VBA in Excel


The bmp file format
Firstly, I had to "study" the bmp format. There are various sources of information in the Web. The bmp file format supports a number of bits/pixel. I need a 16 colour file (although the image would be black and white).

So I created a bmp file in MSpaint and I got the hex data from it thanks to the following website.
https://www.mobilefish.com/services/hex_editor/hex_editor.php

In the particular variation of the bmp file there is a file header that consists of 10 bytes and the BITMAPV4HEADER that consists of 108 byte. As a result of it The first 118 bytes are the metadata of the file and the rest of the bytes contain the image data.

In these 118 bytes there are many pieces of information.
  • filesize
  • height and width in pixels
  • resolution (pixels per inch or something like that)
  • bits per pixel
  • etc

In case of the 16 colour bmp file the 118 bytes contain also the palette. The 16 colours are defined by four bytes, the RGB value of the colour and the Alpha of the colour (i do not know what it is but these bytes are always zero).

The following facts must be taken into account.
  • In the colour palette the first byte is not the Red but the Blue. The order is: Blue, Green, Red, Alpha (always zero).
  • After the first 118 the pixel data come. The order is from left to right BUT from bottom to top
  • Each byte contains the information of two adjacent pixels. The nibble (4 bit number) shows the number of the colour in the palette.
  • The number of bytes per line should be a product of four. In order to coply with this the suitable number of zeros should be added to the file and then proceed to the next line.

I could attach an xlsx file that may be useful to others but it seems I do not have permission for that.

The code
In the first code I created a 5x7 bmp image that shows a capital letter. It's the first implementation, the final code would be more complex.


Rich (BB code): 
Sub Code03()
Dim Seira As Integer
Dim Stili As Integer
Dim OffsetO As Integer
Dim OffsetK As Integer
Dim CharacterMask(7, 5) As Boolean
Dim handle As Long

Sheets("TheCodeStarts").Activate

Select Case Cells(1, 2)
       Case Is = "A"
            CharacterMask(1, 1) = True
            CharacterMask(1, 2) = False
            CharacterMask(1, 3) = False
            CharacterMask(1, 4) = False
            CharacterMask(1, 5) = True


            CharacterMask(2, 1) = True
            CharacterMask(2, 2) = False
            CharacterMask(2, 3) = False
            CharacterMask(2, 4) = False
            CharacterMask(2, 5) = True

            CharacterMask(3, 1) = True
            CharacterMask(3, 2) = True
            CharacterMask(3, 3) = True
            CharacterMask(3, 4) = True
            CharacterMask(3, 5) = True

            CharacterMask(4, 1) = True
            CharacterMask(4, 2) = False
            CharacterMask(4, 3) = False
            CharacterMask(4, 4) = False
            CharacterMask(4, 5) = True

            CharacterMask(5, 1) = True
            CharacterMask(5, 2) = False
            CharacterMask(5, 3) = False
            CharacterMask(5, 4) = False
            CharacterMask(5, 5) = True

            CharacterMask(6, 1) = True
            CharacterMask(6, 2) = False
            CharacterMask(6, 3) = False
            CharacterMask(6, 4) = False
            CharacterMask(6, 5) = True

            CharacterMask(7, 1) = False
            CharacterMask(7, 2) = True
            CharacterMask(7, 3) = True
            CharacterMask(7, 4) = True
            CharacterMask(7, 5) = False


       Case Is = "B"
            CharacterMask(1, 1) = True
            CharacterMask(1, 2) = True
            CharacterMask(1, 3) = True
            CharacterMask(1, 4) = True
            CharacterMask(1, 5) = False

            CharacterMask(2, 1) = True
            CharacterMask(2, 2) = False
            CharacterMask(2, 3) = False
            CharacterMask(2, 4) = False
            CharacterMask(2, 5) = True


            CharacterMask(3, 1) = True
            CharacterMask(3, 2) = False
            CharacterMask(3, 3) = False
            CharacterMask(3, 4) = False
            CharacterMask(3, 5) = True


            CharacterMask(4, 1) = True
            CharacterMask(4, 2) = True
            CharacterMask(4, 3) = True
            CharacterMask(4, 4) = True
            CharacterMask(4, 5) = False


            CharacterMask(5, 1) = True
            CharacterMask(5, 2) = False
            CharacterMask(5, 3) = False
            CharacterMask(5, 4) = False
            CharacterMask(5, 5) = True


            CharacterMask(6, 1) = True
            CharacterMask(6, 2) = False
            CharacterMask(6, 3) = False
            CharacterMask(6, 4) = False
            CharacterMask(6, 5) = True




            CharacterMask(7, 1) = True
            CharacterMask(7, 2) = True
            CharacterMask(7, 3) = True
            CharacterMask(7, 4) = True
            CharacterMask(7, 5) = False


       Case Is = "D"
            CharacterMask(1, 1) = True
            CharacterMask(1, 2) = True
            CharacterMask(1, 3) = True
            CharacterMask(1, 4) = False
            CharacterMask(1, 5) = False


            CharacterMask(2, 1) = True
            CharacterMask(2, 2) = False
            CharacterMask(2, 3) = False
            CharacterMask(2, 4) = True
            CharacterMask(2, 5) = False


            CharacterMask(3, 1) = True
            CharacterMask(3, 2) = False
            CharacterMask(3, 3) = False
            CharacterMask(3, 4) = False
            CharacterMask(3, 5) = True


            CharacterMask(4, 1) = True
            CharacterMask(4, 2) = False
            CharacterMask(4, 3) = False
            CharacterMask(4, 4) = False
            CharacterMask(4, 5) = True


            CharacterMask(5, 1) = True
            CharacterMask(5, 2) = False
            CharacterMask(5, 3) = False
            CharacterMask(5, 4) = False
            CharacterMask(5, 5) = True


            CharacterMask(6, 1) = True
            CharacterMask(6, 2) = False
            CharacterMask(6, 3) = False
            CharacterMask(6, 4) = True
            CharacterMask(6, 5) = False




            CharacterMask(7, 1) = True
            CharacterMask(7, 2) = True
            CharacterMask(7, 3) = True
            CharacterMask(7, 4) = False
            CharacterMask(7, 5) = False


       Case Is = "E"
            CharacterMask(1, 1) = True
            CharacterMask(1, 2) = True
            CharacterMask(1, 3) = True
            CharacterMask(1, 4) = True
            CharacterMask(1, 5) = True


            CharacterMask(2, 1) = True
            CharacterMask(2, 2) = False
            CharacterMask(2, 3) = False
            CharacterMask(2, 4) = False
            CharacterMask(2, 5) = False


            CharacterMask(3, 1) = True
            CharacterMask(3, 2) = False
            CharacterMask(3, 3) = False
            CharacterMask(3, 4) = False
            CharacterMask(3, 5) = False


            CharacterMask(4, 1) = True
            CharacterMask(4, 2) = True
            CharacterMask(4, 3) = True
            CharacterMask(4, 4) = True
            CharacterMask(4, 5) = falsee


            CharacterMask(5, 1) = True
            CharacterMask(5, 2) = False
            CharacterMask(5, 3) = False
            CharacterMask(5, 4) = False
            CharacterMask(5, 5) = False


            CharacterMask(6, 1) = True
            CharacterMask(6, 2) = False
            CharacterMask(6, 3) = False
            CharacterMask(6, 4) = False
            CharacterMask(6, 5) = False




            CharacterMask(7, 1) = True
            CharacterMask(7, 2) = True
            CharacterMask(7, 3) = True
            CharacterMask(7, 4) = True
            CharacterMask(7, 5) = True
End Select




OffsetO = 1
OffsetK = 8






'Define colour codes, colour the cells
For Stili = 1 To 5
    For Seira = 1 To 7
        If CharacterMask(Seira, Stili) = False Then
           Cells(Seira + OffsetK, Stili + OffsetO) = 15
           Cells(Seira + OffsetK, Stili + OffsetO).Interior.Color = RGB(255, 255, 255)
           Cells(Seira + OffsetK, Stili + OffsetO).Font.Color = RGB(0, 0, 0)
        Else
           Cells(Seira + OffsetK, Stili + OffsetO) = 0
           Cells(Seira + OffsetK, Stili + OffsetO).Interior.Color = RGB(0, 0, 0)
           Cells(Seira + OffsetK, Stili + OffsetO).Font.Color = RGB(255, 255, 255)
        End If
    
    
    Next Seira
Next Stili




'Make the bytes


For Stili = 1 To 4
    For Seira = 9 To 15
        Cells(Seira, 10 + Stili) = Hex(Cells(Seira, Stili * 2) * 16 + Cells(Seira, Stili * 2 + 1))


    Next Seira
Next Stili








'Save to file
    handle = FreeFile
    Open "C:\Users\username\Desktop\VBA-" & Cells(1, 2) & ".bmp" For Binary As #handle 


    For Seira = 2 To 119 'Header
        Put #handle , , CByte("&H" & Cells(4, Seira))
    Next Seira
 


   For Seira = 9 To 15
       For Stili = 11 To 14
           Put #handle , , CByte("&H" & Cells(Seira, Stili))
       Next Stili
   Next Seira








Close #handle 


End Sub


The code does not just make the file. It performs the following.
  • Select the colour for each pixel according to the Character's Mask.
  • The colour values (not the RGB values but the colour index from the palette) are stored in an excel sheet. The cells are "painted" to either black or white colour. The selected character is drawn upside down due to the fact that the order of the lines in the bmp file is from bottom to top.
  • The nibbles are joint into bytes and the stuffing bits are added.
  • Finally, it is stored in a file.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
As you can see in the code above, I declare a 5x7 array of Booleans and depending on the selected character I give either TRUE or FALSE value to the Booleans of the array. Initially, I had done the following.

Rich (BB code): 
Dim CharacterMask(7, 5) As Boolean
Dim Capital_A_Mask(7, 5) As Boolean
Dim Capital_B_Mask(7, 5) As Boolean
Dim Capital_D_Mask(7, 5) As Boolean
Dim Capital_E_Mask(7, 5) As Boolean

....
....
....

Select Case Cells(1, 2)
       Case Is = "A"
            CharacterMask = Capital_A_Mask


       Case Is = "B"
            CharacterMask = Capital_B_Mask

       Case Is = "D"
            CharacterMask = Capital_D_Mask


       Case Is = "E"
            CharacterMask = Capital_A_Mask
End Select

Unfortunately, I could not fill an array with the values of another array. Another failure was the following code.

Rich (BB code): 
CharacterMask = (True,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true,true)

I would like to create array one array for each character as a constant and use one array variable. Can it be done?
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Date formula not applied the same to all Listbox entries
Replies
2
Views
50
ipbr21054
I
S
  • Question Question
Macro for
Replies
2
Views
120
Sanderb
S
A
  • Solved
VBA Case Error
Replies
2
Views
65
Ark68
A
S
  • Question Question
Help with Pivot Table Macro
Replies
0
Views
64
SCPbrito
S
H
  • Locked
  • Question Question
Help referencing a series name that contains data linked to a cell VBA
Replies
1
Views
36
Fluff
Fluff

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top