As you can see below, the same code can be used to generate a static cursor (a file with the "cur" extension), because there are only a few differences between icons and cursors.
The images must be no bigger than 256x256 pixels.
The images used can be bitmap (BMP) files or Portable Network Graphic (PNG) files, but the following code can be used only for BMP images.
Here is the code used by me:
FUNCTION genicob
****************************************************
* Generates an ico / cur file from one or more bmp *
****************************************************
* Parameters
* - laIcons array with the name (and path) of the bmp files (passed by reference)
* - lcFileName name of the output file
* - llCur (optional) .F. (default) the result is icon /.T. the result is cursor
* - lnHotX (optional) the x coordinate for the hotspot (cursor only, where the mouse clicks)
* - lnHotY (optional) the y coordinate for the hotspot (cursor only, where the mouse clicks)
**********************************************
* Generates an ico / cur file from one or more bmp *
****************************************************
* Parameters
* - laIcons array with the name (and path) of the bmp files (passed by reference)
* - lcFileName name of the output file
* - llCur (optional) .F. (default) the result is icon /.T. the result is cursor
* - lnHotX (optional) the x coordinate for the hotspot (cursor only, where the mouse clicks)
* - lnHotY (optional) the y coordinate for the hotspot (cursor only, where the mouse clicks)
**********************************************
LPARAMETERS laIcons,lcFileName,llCur,lnHotX,lnHotY
LOCAL lcResult,lcResult2,lnIcos,lni,lcImg,lnWidth,lnHeight,lnSize,lcS,lnBPix,lnColors,llRes,lnOffset
IF PCOUNT() < 5 OR VARTYPE(m.lnHotY) <> "N"
lnHotY = 0
ENDIF
lnHotY = FLOOR(MIN(MAX(m.lnHotY,0),65535))
IF PCOUNT() < 4 OR VARTYPE(m.lnHotX) <> "N"
lnHotX = 0
ENDIF
lnHotX = FLOOR(MIN(MAX(m.lnHotX,0),65535))
IF PCOUNT() < 3 OR VARTYPE(m.llCur) <> "L"
llCur = .F.
ENDIF
llRes = .T.
lnIcos = ALEN(laIcons)
lcResult = CHR(0) + CHR(0) + CHR(IIF(m.llCur,2,1)) + CHR(0) + BINTOC(m.lnIcos, "2RS")
lcResult2 = ""
lnOffset = 6 + m.lnIcos * 16
FOR lni = 1 TO m.lnIcos
STORE 0 TO lnWidth,lnHeight,lnSize,lnBPix,lnColors
lcS = ""
IF FILE(m.laIcons[m.lni])
IF is_bmp2(m.laIcons[m.lni],256,256,@lnWidth,@lnHeight,@lnSize,@lcS,@lnBPix,@lnColors) = 0
IF !m.llCur
lcResult = m.lcResult + CHR(m.lnWidth) + CHR(m.lnHeight) + CHR(m.lnColors) + CHR(0) + CHR(1) + CHR(0) + BINTOC(m.lnBPix, "2RS") + BINTOC(m.lnSize, "4RS") + BINTOC(m.lnOffset, "4RS")
ELSE
lcResult = m.lcResult + CHR(m.lnWidth) + CHR(m.lnHeight) + CHR(m.lnColors) + CHR(0) + BINTOC(MIN(m.lnHotX,m.lnWidth), "2RS") + BINTOC(MIN(m.lnHotY,m.lnHeight), "2RS") + BINTOC(m.lnSize, "4RS") + BINTOC(m.lnOffset, "4RS")
ENDIF
lcResult2 = m.lcResult2 + m.lcS
lnOffset = m.lnOffset + m.lnSize
ELSE
llRes = .F.
EXIT
ENDIF
ELSE
llRes = .F.
EXIT
ENDIF
NEXT
IF m.llRes
STRTOFILE(m.lcResult + m.lcResult2,FORCEEXT(m.lcFileName,IIF(!m.llCur,"ico","cur")))
ENDIF
RETURN m.llRes
LOCAL lcResult,lcResult2,lnIcos,lni,lcImg,lnWidth,lnHeight,lnSize,lcS,lnBPix,lnColors,llRes,lnOffset
IF PCOUNT() < 5 OR VARTYPE(m.lnHotY) <> "N"
lnHotY = 0
ENDIF
lnHotY = FLOOR(MIN(MAX(m.lnHotY,0),65535))
IF PCOUNT() < 4 OR VARTYPE(m.lnHotX) <> "N"
lnHotX = 0
ENDIF
lnHotX = FLOOR(MIN(MAX(m.lnHotX,0),65535))
IF PCOUNT() < 3 OR VARTYPE(m.llCur) <> "L"
llCur = .F.
ENDIF
llRes = .T.
lnIcos = ALEN(laIcons)
lcResult = CHR(0) + CHR(0) + CHR(IIF(m.llCur,2,1)) + CHR(0) + BINTOC(m.lnIcos, "2RS")
lcResult2 = ""
lnOffset = 6 + m.lnIcos * 16
FOR lni = 1 TO m.lnIcos
STORE 0 TO lnWidth,lnHeight,lnSize,lnBPix,lnColors
lcS = ""
IF FILE(m.laIcons[m.lni])
IF is_bmp2(m.laIcons[m.lni],256,256,@lnWidth,@lnHeight,@lnSize,@lcS,@lnBPix,@lnColors) = 0
IF !m.llCur
lcResult = m.lcResult + CHR(m.lnWidth) + CHR(m.lnHeight) + CHR(m.lnColors) + CHR(0) + CHR(1) + CHR(0) + BINTOC(m.lnBPix, "2RS") + BINTOC(m.lnSize, "4RS") + BINTOC(m.lnOffset, "4RS")
ELSE
lcResult = m.lcResult + CHR(m.lnWidth) + CHR(m.lnHeight) + CHR(m.lnColors) + CHR(0) + BINTOC(MIN(m.lnHotX,m.lnWidth), "2RS") + BINTOC(MIN(m.lnHotY,m.lnHeight), "2RS") + BINTOC(m.lnSize, "4RS") + BINTOC(m.lnOffset, "4RS")
ENDIF
lcResult2 = m.lcResult2 + m.lcS
lnOffset = m.lnOffset + m.lnSize
ELSE
llRes = .F.
EXIT
ENDIF
ELSE
llRes = .F.
EXIT
ENDIF
NEXT
IF m.llRes
STRTOFILE(m.lcResult + m.lcResult2,FORCEEXT(m.lcFileName,IIF(!m.llCur,"ico","cur")))
ENDIF
RETURN m.llRes
******************************************************************
* Check if a file is a bmp
* Compare width and height of the image is compared with maximum values
* Return the current width and height in pixels, the file size in bytes and the picture in the last parameters
******************************************************************
* Return value is
* 0 - success
* 1 - not a BMP
* 2 - too wide
* 4 - too high
* 8 - incorect number of parameters
******************************************************************
* is_bmp2 must be called with 9 parameters:
* - image file
* - maximum width
* - maximum height
* - (output) width in pixels
* - (output) height in pixels
* - (outut) size in bytes of the file
* - (output) the image file as a string
* - (output) the number bites per pixel
* - (output) the number of colors
******************************************************************
* Check if a file is a bmp
* Compare width and height of the image is compared with maximum values
* Return the current width and height in pixels, the file size in bytes and the picture in the last parameters
******************************************************************
* Return value is
* 0 - success
* 1 - not a BMP
* 2 - too wide
* 4 - too high
* 8 - incorect number of parameters
******************************************************************
* is_bmp2 must be called with 9 parameters:
* - image file
* - maximum width
* - maximum height
* - (output) width in pixels
* - (output) height in pixels
* - (outut) size in bytes of the file
* - (output) the image file as a string
* - (output) the number bites per pixel
* - (output) the number of colors
******************************************************************
FUNCTION is_bmp2
LPARAMETERS lcFil,lnWidthm,lnHeightm,lnWidthR,lnHeightR,lnSize,lcS,lnBPix,lnColors
LOCAL llSgn,llIsbmp,lcS2,lcSourceRow,lnSourceRow,lnSourceRowLen,lnPixel,lcPixel,lcDestRow,lnSourceOff,lnSourcePixel,lnBytes,lnColorPixel,lnDestChar,lnDestPosPixel,lc2Pixels,lnWidth,lnHeight
llIsbmp=0
IF PCOUNT() < 6 OR VARTYPE(m.lnWidthm) <> "N" OR VARTYPE(m.lnHeightm) <> "N" OR VARTYPE(m.lcFil) <> "C"
RETURN 8
ENDIF
lcs = FILETOSTR(FULLPATH(m.lcfil))
llsgn=ASC(SUBSTR(m.lcs,1,1))=66 and ASC(SUBSTR(m.lcs,2,1))=77
IF m.llsgn
STORE CTOBIN(SUBSTR(m.lcs,19,4),"4RS") TO lnWidth,lnWidthR
IF m.lnWidth > m.lnWidthm
llIsbmp = m.llIsbmp + 2
ENDIF
IF m.lnWidth = 256
lnWidthR = 0
ENDIF
STORE CTOBIN(SUBSTR(m.lcs,23,4),"4RS") TO lnHeight,lnHeightR
IF m.lnHeight > m.lnHeightm
llIsbmp = m.llIsbmp + 4
ENDIF
IF m.lnHeight = 256
lnHeightR = 0
ENDIF
lnBPix = CTOBIN(SUBSTR(m.lcs,29,2),"2RS")
lnColors = CTOBIN(SUBSTR(m.lcs,47,4),"4RS")
* Prepare the mask
lcS2 = ''
lnSourceOff = 1 + CTOBIN(SUBSTR(m.lcs,11,4),"4RS") && bitmap offset
DO CASE
CASE MOD(m.lnBPix,8) = 0 && color depth = 8,16,24 or 32
lnBytes = CEILING(m.lnBPix / 8)
lnSourceRowLen = m.lnWidth * m.lnBytes && number of chars for a line of pixels
IF MOD(m.lnSourceRowLen,4) <> 0 && is always rounded to 4 bytes (4 chars)
lnSourceRowLen = m.lnSourceRowLen + 4 - MOD(m.lnSourceRowLen,4)
ENDIF
FOR lnSourceRow = 1 TO m.lnHeight
lcSourceRow = SUBSTR(m.lcS, m.lnSourceOff + (m.lnSourceRow - 1) * m.lnSourceRowLen, m.lnSourceRowLen)
lcDestRow = ''
lnDestChar = 0
lnDestPosPixel = 0
FOR lnPixel = 1 TO m.lnWidth
IF m.lnDestPosPixel = 8
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
m.lnDestPosPixel = 0
lnDestChar = 0
ENDIF
lcPixel = SUBSTR(m.lcSourceRow,1 + (m.lnPixel - 1) * m.lnBytes, m.lnBytes)
IF m.lnBytes = 3
lnColorPixel = CTOBIN(m.lcPixel + CHR(0) , '4RS')
ELSE
lnColorPixel = CTOBIN(m.lcPixel , LTRIM(STR(m.lnBytes)) + 'RS')
ENDIF
IF BITXOR(m.lnColorPixel , CEILING(2 ^ m.lnBPix -1) ) = 0 &&AND m.lnColorPixel <> RGB(255,255,255)
lnDestChar = BITSET(m.lnDestChar , 7-m.lnDestPosPixel)
ENDIF
lnDestPosPixel = m.lnDestPosPixel + 1
NEXT
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
IF MOD(LEN(m.lcDestRow),4) <> 0
lcDestRow = m.lcDestRow + REPLICATE(CHR(0),4 - MOD(LEN(m.lcDestRow),4))
ENDIF
lcS2 = m.lcS2 + m.lcDestRow
NEXT
CASE m.lnBPix = 4 && color depth = 4 (16 colors)
lnBytes = 0.5
lnSourceRowLen = m.lnWidth * m.lnBytes && number of chars for a line of pixels
IF MOD(m.lnSourceRowLen,4) <> 0 && is always rounded to 4 bytes (4 chars)
lnSourceRowLen = CEILING(m.lnSourceRowLen + 4 - MOD(m.lnSourceRowLen,4))
ENDIF
FOR lnSourceRow = 1 TO m.lnHeight
lcSourceRow = SUBSTR(m.lcS, m.lnSourceOff + (m.lnSourceRow - 1) * m.lnSourceRowLen, m.lnSourceRowLen)
lcDestRow = ''
lnDestChar = 0
lnDestPosPixel = 0
FOR lnPixel = 1 TO m.lnWidth
IF m.lnDestPosPixel = 8
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
m.lnDestPosPixel = 0
lnDestChar = 0
ENDIF
IF MOD(m.lnPixel,2) = 1
lc2Pixels = SUBSTR(m.lcSourceRow,1 + FLOOR(m.lnPixel / 2) , 1)
lcPixel = SUBSTR(TRANSFORM(ASC(m.lc2Pixels),"@O"),9,1)
ELSE
lcPixel = RIGHT(TRANSFORM(ASC(m.lc2Pixels),"@O"),1)
ENDIF
IF ISDIGIT(m.lcPixel)
lnColorPixel = VAL(m.lcPixel)
ELSE
lnColorPixel = ASC(m.lcPixel) - 55
ENDIF
IF BITXOR(m.lnColorPixel , 15 ) = 0
lnDestChar = BITSET(m.lnDestChar , 7-m.lnDestPosPixel)
ENDIF
lnDestPosPixel = m.lnDestPosPixel + 1
NEXT
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
IF MOD(LEN(m.lcDestRow),4) <> 0
lcDestRow = m.lcDestRow + REPLICATE(CHR(0),4 - MOD(LEN(m.lcDestRow),4))
ENDIF
lcS2 = m.lcS2 + m.lcDestRow
NEXT
CASE m.lnBPix = 1 && monchrome
lcS2 = SUBSTR(m.lcS, m.lnSourceOff)
OTHERWISE
lcS2 = ""
ENDCASE
IF m.lnHeight = 0
lcS = SUBSTR(STUFF(m.lcS , 23, 4, BINTOC( 512,"4RS")),15) + m.lcS2
ELSE
lcS = SUBSTR(STUFF(m.lcS , 23, 4, BINTOC(2 * m.lnHeight,"4RS")),15) + m.lcS2
ENDIF
lnSize = LEN(m.lcs)
ELSE
llIsbmp = m.llIsbmp + 1
ENDIF
RETURN m.llIsbmp
LPARAMETERS lcFil,lnWidthm,lnHeightm,lnWidthR,lnHeightR,lnSize,lcS,lnBPix,lnColors
LOCAL llSgn,llIsbmp,lcS2,lcSourceRow,lnSourceRow,lnSourceRowLen,lnPixel,lcPixel,lcDestRow,lnSourceOff,lnSourcePixel,lnBytes,lnColorPixel,lnDestChar,lnDestPosPixel,lc2Pixels,lnWidth,lnHeight
llIsbmp=0
IF PCOUNT() < 6 OR VARTYPE(m.lnWidthm) <> "N" OR VARTYPE(m.lnHeightm) <> "N" OR VARTYPE(m.lcFil) <> "C"
RETURN 8
ENDIF
lcs = FILETOSTR(FULLPATH(m.lcfil))
llsgn=ASC(SUBSTR(m.lcs,1,1))=66 and ASC(SUBSTR(m.lcs,2,1))=77
IF m.llsgn
STORE CTOBIN(SUBSTR(m.lcs,19,4),"4RS") TO lnWidth,lnWidthR
IF m.lnWidth > m.lnWidthm
llIsbmp = m.llIsbmp + 2
ENDIF
IF m.lnWidth = 256
lnWidthR = 0
ENDIF
STORE CTOBIN(SUBSTR(m.lcs,23,4),"4RS") TO lnHeight,lnHeightR
IF m.lnHeight > m.lnHeightm
llIsbmp = m.llIsbmp + 4
ENDIF
IF m.lnHeight = 256
lnHeightR = 0
ENDIF
lnBPix = CTOBIN(SUBSTR(m.lcs,29,2),"2RS")
lnColors = CTOBIN(SUBSTR(m.lcs,47,4),"4RS")
* Prepare the mask
lcS2 = ''
lnSourceOff = 1 + CTOBIN(SUBSTR(m.lcs,11,4),"4RS") && bitmap offset
DO CASE
CASE MOD(m.lnBPix,8) = 0 && color depth = 8,16,24 or 32
lnBytes = CEILING(m.lnBPix / 8)
lnSourceRowLen = m.lnWidth * m.lnBytes && number of chars for a line of pixels
IF MOD(m.lnSourceRowLen,4) <> 0 && is always rounded to 4 bytes (4 chars)
lnSourceRowLen = m.lnSourceRowLen + 4 - MOD(m.lnSourceRowLen,4)
ENDIF
FOR lnSourceRow = 1 TO m.lnHeight
lcSourceRow = SUBSTR(m.lcS, m.lnSourceOff + (m.lnSourceRow - 1) * m.lnSourceRowLen, m.lnSourceRowLen)
lcDestRow = ''
lnDestChar = 0
lnDestPosPixel = 0
FOR lnPixel = 1 TO m.lnWidth
IF m.lnDestPosPixel = 8
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
m.lnDestPosPixel = 0
lnDestChar = 0
ENDIF
lcPixel = SUBSTR(m.lcSourceRow,1 + (m.lnPixel - 1) * m.lnBytes, m.lnBytes)
IF m.lnBytes = 3
lnColorPixel = CTOBIN(m.lcPixel + CHR(0) , '4RS')
ELSE
lnColorPixel = CTOBIN(m.lcPixel , LTRIM(STR(m.lnBytes)) + 'RS')
ENDIF
IF BITXOR(m.lnColorPixel , CEILING(2 ^ m.lnBPix -1) ) = 0 &&AND m.lnColorPixel <> RGB(255,255,255)
lnDestChar = BITSET(m.lnDestChar , 7-m.lnDestPosPixel)
ENDIF
lnDestPosPixel = m.lnDestPosPixel + 1
NEXT
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
IF MOD(LEN(m.lcDestRow),4) <> 0
lcDestRow = m.lcDestRow + REPLICATE(CHR(0),4 - MOD(LEN(m.lcDestRow),4))
ENDIF
lcS2 = m.lcS2 + m.lcDestRow
NEXT
CASE m.lnBPix = 4 && color depth = 4 (16 colors)
lnBytes = 0.5
lnSourceRowLen = m.lnWidth * m.lnBytes && number of chars for a line of pixels
IF MOD(m.lnSourceRowLen,4) <> 0 && is always rounded to 4 bytes (4 chars)
lnSourceRowLen = CEILING(m.lnSourceRowLen + 4 - MOD(m.lnSourceRowLen,4))
ENDIF
FOR lnSourceRow = 1 TO m.lnHeight
lcSourceRow = SUBSTR(m.lcS, m.lnSourceOff + (m.lnSourceRow - 1) * m.lnSourceRowLen, m.lnSourceRowLen)
lcDestRow = ''
lnDestChar = 0
lnDestPosPixel = 0
FOR lnPixel = 1 TO m.lnWidth
IF m.lnDestPosPixel = 8
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
m.lnDestPosPixel = 0
lnDestChar = 0
ENDIF
IF MOD(m.lnPixel,2) = 1
lc2Pixels = SUBSTR(m.lcSourceRow,1 + FLOOR(m.lnPixel / 2) , 1)
lcPixel = SUBSTR(TRANSFORM(ASC(m.lc2Pixels),"@O"),9,1)
ELSE
lcPixel = RIGHT(TRANSFORM(ASC(m.lc2Pixels),"@O"),1)
ENDIF
IF ISDIGIT(m.lcPixel)
lnColorPixel = VAL(m.lcPixel)
ELSE
lnColorPixel = ASC(m.lcPixel) - 55
ENDIF
IF BITXOR(m.lnColorPixel , 15 ) = 0
lnDestChar = BITSET(m.lnDestChar , 7-m.lnDestPosPixel)
ENDIF
lnDestPosPixel = m.lnDestPosPixel + 1
NEXT
lcDestRow = m.lcDestRow + CHR(m.lnDestChar)
IF MOD(LEN(m.lcDestRow),4) <> 0
lcDestRow = m.lcDestRow + REPLICATE(CHR(0),4 - MOD(LEN(m.lcDestRow),4))
ENDIF
lcS2 = m.lcS2 + m.lcDestRow
NEXT
CASE m.lnBPix = 1 && monchrome
lcS2 = SUBSTR(m.lcS, m.lnSourceOff)
OTHERWISE
lcS2 = ""
ENDCASE
IF m.lnHeight = 0
lcS = SUBSTR(STUFF(m.lcS , 23, 4, BINTOC( 512,"4RS")),15) + m.lcS2
ELSE
lcS = SUBSTR(STUFF(m.lcS , 23, 4, BINTOC(2 * m.lnHeight,"4RS")),15) + m.lcS2
ENDIF
lnSize = LEN(m.lcs)
ELSE
llIsbmp = m.llIsbmp + 1
ENDIF
RETURN m.llIsbmp
The code can be used like this:
DIMENSION laIcons[1]
* icon
laIcons[1] = HOME(4) + "Bitmaps\Tlbr_w95\SAVE.BMP"
?genicob(@laIcons,"SAVE")
* cursor
laIcons[1] = HOME(4) + "Bitmaps\Tlbr_w95\SAVE.BMP"
?genicob(@laIcons,"SAVE",.T.)
PUBLIC ofrm
ofrm = CREATEOBJECT("myform")
ofrm.show()
DEFINE CLASS myform as Form
icon = "SAVE.ico"
mousepointer = 99
mouseicon = "SAVE.cur"
ENDDEFINE
Check the attached icon.
First I have created a 256x256 24-bit BMP picture, using Windows Paint.
This picture I resized it (and saved) into another 4 pictures: 128x128, 64x64, 48x48 and 32x32
When necessary I made some fine adjustments to the resized pictures
Finally I have used MS Paint to create the 16x16 picture.
The generated icons contains all these six pictures.
Related links
Niciun comentariu:
Trimiteți un comentariu