Creating bitmap BMP pictures without API calls (2)

In the previous post, we created a simple small picture.
Let's keep it simple, and change only the color of pixels, from white to red.

You've already seen that each row of pixels must have a length multiple of 4.
Because each pixel took three bytes, the trailing zeroes have such a complicated formula

****************************************************

* Creating a 10 x 5 bitmap with red backgroud

****************************************************

* The midmap look like this:

* RRRRRRRRRR

* RRRRRRRRRR

* RRRRRRRRRR

* RRRRRRRRRR

* RRRRRRRRRR

* One R is a red pixel

****************************************************

LOCAL loBmp, lcTrailerZeros, lcRedPixel, lcRedRow

loBmp = CREATEOBJECT("bmpcreator")

loBmp.nWidth = 10

loBmp.nHeight = 5

* Each row of pixels must have as a length in bytes a multiple of 4. If necessary a few CHR(0) are added

lcTrailerZeros = IIF(MOD( m.loBmp.nWidth * 3,4) <> 0, REPLICATE(CHR(0),4 - MOD( m.loBmp.nWidth * 3,4)), "")

* One pixel has three bytes, corresponding to RGB (Red is the rightmost, blue is the leftmost)

lcRedPixel = CHR(0) + CHR(0) + CHR(255)

* One row contain loBmp.nWidth npixels; DO NOT FORGET the trailing zeroes

lcRedRow = REPLICATE(m.lcRedPixel, m.loBmp.nWidth) + m.lcTrailerZeros

* The BITMAP is a loBmp.nHeight of rows

loBmp.cBitmap = REPLICATE(m.lcRedRow, m.loBmp.nHeight)

loBmp.genbmp("02")

DEFINE CLASS bmpcreator as Custom

      * Generic properties

      nWidth = 1 && Bitmap width in pixels

      nHeight = 1 && bitmap height in pixels

      cBitmap = '' && the bitmap as a string of RGB triplets

      **************************************************************************************

      * generic procedure that writes the bitmap to a BMp file, stored in cBitmap property

      **************************************************************************************

      PROCEDURE genbmp

            *

            * Returns the name of the bmp file

            *

            * Parameters:

            * - tcFile (optional) file name. By default sys(2015)

            *

            LPARAMETERS tcFile

            LOCAL lni,lnByteLength,lcSa,lnNumber

            IF PCOUNT() < 1

                  tcFile = SYS(2015)

            ENDIF

            tcFile = FORCEEXT(m.tcFile, 'bmp')

            lnByteLength = LEN(This.cBitmap)

            * Header

            * Bitmap header field: BM (CHR(0x42)+CHR(0x4D))

            lcSa = CHR(0x42) + CHR(0x4D)

            * File length (file dimension in bytes  in hexadecimal)

            lnNumber = This.DecTohex(m.lnByteLength + 56)

            lcSa = m.lcSa + m.lnNumber

            FOR lni = 1 TO 8 - LEN(m.lnNumber)

                  lcSa = m.lcSa + CHR(0)

            NEXT

            *CHR(0x36)=3*16+6=56=header length in bytes

            *CHR(0x28)=2*16+8=40=number of bytes taken by the structure that follows the header

            lcSa = m.lcSa + CHR(0x36) + CHR(0) + CHR(0) + CHR(0) + CHR(0x28) + CHR(0) + CHR(0) + CHR(0)

            * bitmap width and height in pixels

            * bitmap width

            lnNumber = This.DecTohex(This.nWidth) &&(lnByteLength/lnSize-2)/3

            lcSa= m.lcSa + m.lnNumber

            FOR lni = 1 TO 4 - LEN(m.lnNumber)

                  lcSa = m.lcSa + CHR(0)

            NEXT

            * bitmap height

            lnNumber = This.DecTohex(This.nHeight)

            lcSa = m.lcSa + m.lnNumber && +CHR(0x0C)+CHR(0)+CHR(0)+CHR(0)

            FOR lni = 1 TO 4 - LEN(m.lnNumber)

                  lcSa = m.lcSa + CHR(0)

            NEXT

            * Number of layers, must be 1

            lcSa = m.lcSa + CHR(0x1) + CHR(0)

            * Color depth: 1, 4, 8 sau 24 (0x18) bits

            lcSa = m.lcSa + CHR(0x18) + CHR(0)

            * Information regarding compression

            lcSa = m.lcSa + CHR(0) + CHR(0) + CHR(0) + CHR(0)

            *  Image length in bytes (can be 0 if is not compressed)

            lnNumber = This.DecTohex(m.lnByteLength)

            lcSa = m.lcSa + m.lnNumber

            FOR lni = 1 TO 8 - LEN(m.lnNumber)

              lcSa = m.lcSa + CHR(0)

            NEXT

            * the device horizontal resolution in pixels

            lcSa = m.lcSa + CHR(0) + CHR(0) + CHR(0) + CHR(0)

            * the device vertical resolution in pixels

            lcSa = m.lcSa + CHR(0) + CHR(0) + CHR(0) + CHR(0)

            * 0 means the entire color set

            lcSa = m.lcSa + CHR(0) + CHR(0)

            * 0 means all the color counts in bitmap representation

            lcSa = m.lcSa + CHR(0) + CHR(0)

            STRTOFILE(m.lcSa + This.cBitmap, m.tcFile)

            RETURN m.tcFile

      ENDPROC

      * function used to represend numbers as char

      PROCEDURE DecTohex

            LPARAMETERS tnNo

            LOCAL lcS,lnC,lnI

            lnI = FLOOR(m.tnNo)

            lcS = ''

            DO WHILE m.lnI != 0

                  lnC = m.lnI % 256

                  lcS = m.lcS + CHR(m.lnC)

                  lnI = FLOOR(m.lnI / 256)

            ENDDO

            IF LEN(m.lcS)=0 && representation of 0

                  lcS = CHR(0)

            ENDIF

            RETURN m.lcS

      ENDPROC

ENDDEFINE


Related posts
http://praisachion.blogspot.com/2017/09/creating-bitmap-bmp-pictures-without_45.html
http://praisachion.blogspot.com/2017/09/creating-bitmap-bmp-pictures-without_44.html
http://praisachion.blogspot.com/2017/09/creating-bitmap-bmp-pictures-without_97.html
http://praisachion.blogspot.com/2017/09/creating-bitmap-bmp-pictures-without_11.html
http://praisachion.blogspot.com/2017/09/creating-bitmap-bmp-pictures-without.html