2014-03-12

Convert BMP to ICO

The code below is a courtesy of Sergey Karimov, and converts BMP files to the ICO format, keeping the same appearance, and quality.

FUNCTION Bmp2ICO(sFile, aFilesName)
    EXTERNAL ARRAY aFilesName

    * sFile - file name for resulting .ico file
    * aFilesName - array with the list of .bmp files

    LOCAL nFiles, i, nf, fn
    m.nFiles = ALEN(m.aFilesName, 1)

    LOCAL ARRAY aFiles(nFiles)
    LOCAL sLine, nOffset, nWidth, nHeight, nBit0, nShift

    FOR m.i = 1 TO m.nFiles
        m.nf = FOPEN(m.aFilesName(m.i))
        IF m.nf < 1
            = WMsg("!", "Cannot open file " + m.aFilesName(m.i) + " !")
            RETURN .F.
        ENDIF
        m.aFiles(m.i) = FREAD(m.nf, 999999)
        = FCLOSE(m.nf)
    ENDFOR

    m.fn = FULLPATH(m.sFile) + IIF(EMPTY(JUSTEXT(m.sFile)), ".ICO", "")
    m.nf = FCREATE(m.fn)
    IF m.nf < 1
        = WMsg("!", "Cannot create file " + m.fn + " !")
        RETURN .F.
    ENDIF

    m.sLine    = ""
    m.sLine    = m.sLine + CHRN( 0, 2) && 0 reserved
    m.sLine    = m.sLine + CHRN( 1, 2) && 2 type
    m.sLine    = m.sLine + CHRN(m.nFiles, 2) && 4 Number of Icons in this file

    m.nOffset = LEN(m.sLine) + 16 * m.nFiles
    FOR m.i = 1 TO m.nFiles
        m.nWidth  = ASC(SUBSTR(m.aFiles(m.i), 19, 1)) &&width  of the image, in pixels
        m.nHeight = ASC(SUBSTR(m.aFiles(m.i), 23, 1)) &&height of the image, in pixels
        m.nBit0      = ASC(SUBSTR(m.aFiles(m.i), 29, 1)) &&Bits per pixel

        m.sLine    = m.sLine + CHR(m.nWidth)  && 0 width  of the image, in pixels
        m.sLine    = m.sLine + CHR(m.nHeight) && 1 height of the image, in pixels (OR & AND bitmaps)
        m.sLine    = m.sLine + SUBSTR(m.aFiles(m.i), 47, 1) && 2 Number of Colors
        m.sLine    = m.sLine + CHR(0)                 && 3 reserved
        m.sLine    = m.sLine + SUBSTR(m.aFiles(m.i), 27, 2) && 4 Number of Planes

        m.sLine = m.sLine + SUBSTR(m.aFiles(m.i), 29, 2) && 6 Bits per pixel

        m.nShift = ASCN(SUBSTR(m.aFiles(m.i), 11, 4)) &&offset from the beginning of the file to the bitmap data

        m.aFiles(m.i) = SUBSTR(m.aFiles(m.i), 15, 40 + IIF(m.nBit0 > 8, 0, 4 * 2^m.nBit0)) + SUBSTR(m.aFiles(m.i), m.nShift+1) &&image
        m.aFiles(m.i) = STUFF(m.aFiles(m.i), 9, 1, CHR(m.nHeight * 2)) &&height of the image, in pixels (OR & AND bitmaps)

        m.nWidth = CEILING(m.nWidth / 8) && meaning bytes in a row for AND bitmap
        m.nWidth = 4 * CEILING(m.nWidth / 4) &&bytes in a row for AND bitmap

        m.aFiles(m.i) = m.aFiles[m.i] + REPLICATE(CHR(0), m.nWidth * m.nHeight) &&AND bitmap

        m.sLine    = m.sLine + CHRN(LEN(m.aFiles(m.i)), 4) && 8 Size of image area
        m.sLine    = m.sLine + CHRN(m.nOffset, 4)       &&12 offset to image area

        m.nOffset = m.nOffset + LEN(m.aFiles(m.i))
    ENDFOR

    = FWRITE(m.nf, m.sLine)

    FOR m.i = 1 TO m.nFiles
        = FWRITE(m.nf, m.aFiles(m.i))
    ENDFOR

    = FCLOSE(m.nf)

    RETURN .T.

*-------------------------------
FUNCTION ASCN(s) &&converts binary string to numeric
    * s - string, bytes go from tail to head

    LOCAL i, n

    m.n = 0
    FOR m.i = LEN(m.s) TO 1 STEP - 1
        m.n = m.n * 256 + ASC(SUBSTR(m.s, m.i, 1))
    ENDFOR

    RETURN m.n

*-------------------------------
FUNCTION CHRN(n, ln) &&converts numeric value to binary string,
    &&bytes go from tail to head
    * n, ln - numeric value and output string length
    LOCAL i, s, sc
    m.s     = ""
    m.sc = m.n
    FOR m.i = 1 TO m.ln
        m.s     = m.s + CHR(m.sc % 256)
        m.sc = INT(m.sc / 256)
    ENDFOR

    RETURN m.s