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
VFP Visual FoxPro and Images, graphics, GdiPlus, GdiPlusX, FoxCharts, FoxPaint, charting, tips and tricks, code samples, VFPX, FoxyPreviewer etc...
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.
Subscribe to:
Posts (Atom)