Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Convert Image to .ICO
Message
From
20/12/2006 11:05:23
 
General information
Forum:
Visual FoxPro
Category:
Windows API functions
Environment versions
Visual FoxPro:
VFP 9 SP1
Miscellaneous
Thread ID:
01178858
Message ID:
01179222
Views:
24
This message has been marked as the solution to the initial question of the thread.
Hi!

Try this one:

Happy Holidays!
Sergey
*==================================
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

nFiles= ALEN(aFilesName,1)

LOCAL ARRAY aFiles[nFiles]
LOCAL sLine, nOffset, nWidth, nHeight, nBit0, nShift

FOR i=1 TO nFiles
	nf= FOPEN(aFilesName[i])
	IF nf<1
		=WMsg("!", "Cannot open file "+aFilesName[i]+" !")
		RETURN .F.
	ENDIF

	aFiles[i]= FREAD(nf, 999999)
	=FCLOSE(nf)
ENDFOR

fn= FULLPATH(sFile)+IIF(EMPTY(JUSTEXT(sFile)),".ICO","")

nf= FCREATE(fn)
IF nf<1
	=WMsg("!", "Cannot create file "+fn+" !")
	RETURN .F.
ENDIF

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

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

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

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

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

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

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

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

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

=FWRITE(nf, sLine)

FOR i=1 TO nFiles
	=FWRITE(nf, aFiles[i])
ENDFOR

=FCLOSE(nf)

RETURN .T.

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

LOCAL i, n

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

RETURN 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

s= ""
sc= n
FOR i=1 TO ln
   s= s+CHR(sc%256)
   sc= INT(sc/256)
ENDFOR

RETURN s
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform