pour en faire une icone valable pour compiler un prg avec EPB
j'ai pas chercher a ré-inventer le roue tout existe deja sur les fourms (et dans mes stocks de codes)
voici un petit code de recup , qui permet de faire une icone a partir d'une image (préalablement reduite a la taille qu'on veux )
Utilisation :
on charge une image (*.bmp ;*.png ;*.tiff,*.jpg )
l'icone sera sauvé au meme endroit que l'image avec le meme nom et l'extension "*.ico"
par defaut la resolution est a 32 mais ça se change ...
Code : Tout sélectionner
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
Declare make_ico(file_image.s,resolution)
Declare createicon(image.l)
Declare.i saveicon(hicon, filename$)
file_image.s=OpenFileRequester("ouvrir un image","c:\","*.Bmp;*.jpg;*.png",1)
resolution=32 ; 64 ;128
Make_ico(file_image.s,resolution)
Procedure Make_ico(file_image.s,resolution)
If file_image.s<>""
If LoadImage(Image_id,file_image.s)
ResizeImage(Image_id,resolution,resolution)
icon_id=CreateIcon(Image.l)
chemin_image.s=GetPathPart(file_image.s)
nom_image.s=GetFilePart(file_image.s,#PB_FileSystem_NoExtension)
nom_icone.s=nom_image.s+"_"+str(resolution)+".ico"
SaveIcon(icon_id, chemin_image.s+nom_icone.s)
Endif
Endif
EndProcedure
Procedure CreateIcon(Image.l)
;Octavius
Protected NewIcon.ICONINFO,Mask.l,Icon.l
Mask=CreateImage(#PB_Any,ImageWidth(Image),ImageHeight(Image),32)
NewIcon\fIcon=#True
NewIcon\hbmMask=ImageID(Mask)
NewIcon\hbmColor=ImageID(Image)
Icon=CreateIconIndirect_(@NewIcon)
FreeImage(Mask)
ProcedureReturn Icon
EndProcedure
Procedure.i SaveIcon(hIcon, filename$)
;Srod
Protected result, iconinfo.ICONINFO, hbmMask, hbmColor
Protected cbitmap.BITMAP, cwidth, cheight, cbitsperpixel, colorcount, colorplanes
Protected mbitmap.BITMAP, mwidth, mheight, fIcon, xHotspot, yHotspot
Protected file, imagebytecount, hdc, oldbitmap, mem, bytesinrow, temp
Protected *bitmapinfo.BITMAPINFO
;Get information regarding the icon.
If Not(GetIconInfo_(hIcon, iconinfo)) : ProcedureReturn 0 : EndIf ;Not a valid icon handle.
fIcon=2-iconinfo\fIcon ;icon = 1, cursor = 2,
If fIcon=2 ;Cursor.
xHotspot=iconinfo\xHotspot
yHotspot=iconinfo\yHotspot
EndIf
;Allocate memory for a BITMAPINFO structure + a color table with 256 entries.
*bitmapinfo = AllocateMemory(SizeOf(BITMAPINFO) + SizeOf(RGBQUAD)<<8)
If *bitmapinfo = 0 : ProcedureReturn 0 :EndIf
;Get the mask (AND) bitmap, which, if the icon is B/W monochrome, contains the colour bitmap.
hbmMask=iconinfo\hbmMask
GetObject_(hbmMask, SizeOf(BITMAP),mbitmap)
mwidth= mbitmap\bmWidth
mheight= mbitmap\bmHeight
;Get the colour (XOR) bitmap.
hbmColor=iconinfo\hbmColor
If hbmColor
GetObject_(hbmColor, SizeOf(BITMAP),cbitmap)
cwidth= cbitmap\bmWidth
cheight= cbitmap\bmHeight
cbitsperpixel = cbitmap\bmBitsPixel
If cbitsperpixel = 0 : cbitsperpixel = 1 : EndIf
If cbitsperpixel < 8
colorcount=Pow(2,cbitsperpixel) ;colorcount = 0 if 8 or more bpp.
EndIf
colorplanes=cbitmap\bmplanes
Else ;Monochrome icon.
cwidth= mwidth
cheight= mheight/2
cbitsperpixel = 1
colorcount=2
colorplanes=1
mheight=cheight
EndIf
;Ready to start creating the file.
file=CreateFile(#PB_Any,filename$)
If file
;Write the data.
;word = 0
WriteWord(file,0)
;word = 1 for icon, 2 for cursor.
WriteWord(file,ficon) ;1 for icon, 2 for cursor.
;word = number of icons in file.
WriteWord(file,1) ;***CHANGE IF EXTENDING CODE TO MORE THAN ONE ICON***
;16 byte ICONDIRENTRY structure, one for each icon.
WriteByte(file, cwidth)
WriteByte(file, cheight)
WriteByte(file, colorcount)
WriteByte(file, 0) ;Reserved.
If ficon=1 ;Icon.
WriteWord(file, colorplanes) ;Should equal 1, -but just in case!
WriteWord(file, cbitsperpixel)
Else ;Cursor.
WriteWord(file, xhotspot)
WriteWord(file, yhotspot)
EndIf
WriteLong(file,0) ;TEMPORARY! WE NEED TO RETURN WHEN WE KNOW THE EXACT QUANTITY.
; Size of (InfoHeader + ANDbitmap + XORbitmap)
WriteLong(file,Loc(file)+4) ;FilePos, where InfoHeader starts
;Now the image data in the form BITMAPINFOHEADER (40 bytes) + colour map for the colour bitmap
;+ bits of colour bitmap + bits of mask bitmap. Gulp! One for each icon.
;40 byte BITMAPINFOHEADER structure.
imagebytecount=SizeOf(BITMAPINFOHEADER)
WriteLong(file, imagebytecount) ;Should be 40.
WriteLong(file, cwidth)
WriteLong(file, cheight+mheight) ;Combined heights of colour + mask images.
WriteWord(file, colorplanes) ;Should equal 1, -but just in case!
WriteWord(file, cbitsperpixel)
WriteLong(file, 0) ;Compression.
WriteLong(file, 0) ;Image size. Valid to set to zero if there's no compression.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
;Colour map. Only applies for <= 8 bpp.
hdc=CreateCompatibleDC_(0) ;Needed in order to get the colour table.
If hbmColor = 0 ;Monochrome icon.
WriteLong(file, #Black)
WriteLong(file, #White)
imagebytecount+SizeOf(rgbquad)*2
Elseif cbitsperpixel<=8 ;Includes 1 bit non-monochrome icons.
;Get colour table.
temp=Pow(2,cbitsperpixel)
bytesinrow = SizeOf(rgbquad)*temp
mem=AllocateMemory(bytesinrow)
oldbitmap=SelectObject_(hdc, hbmColor)
GetDIBColorTable_(hdc, 0, temp, mem)
WriteData(file, mem, bytesinrow) ;Write color table.
FreeMemory(mem)
SelectObject_(hdc, oldbitmap)
imagebytecount+bytesinrow
Endif
;Now the colour image bits. We use GetDiBits_() for this.
bytesinrow = (cwidth*cbitsperpixel+31)/32*4 ;Aligned to a 4-byte boundary.
bytesinrow * cheight
mem=AllocateMemory(bytesinrow)
*bitmapinfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER)
*bitmapinfo\bmiHeader\biWidth=cwidth
*bitmapinfo\bmiHeader\biPlanes=colorplanes
*bitmapinfo\bmiHeader\biBitCount=cbitsperpixel
If hbmColor
*bitmapinfo\bmiHeader\biHeight=cheight
GetDIBits_(hdc,hbmColor,0,cheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Else ;Monochrome color image is the bottom half of the mask image.
*bitmapinfo\bmiHeader\biHeight=2*cheight
GetDIBits_(hdc,hbmMask,0,cheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Endif
WriteData(file, mem, bytesinrow)
FreeMemory(mem)
imagebytecount+bytesinrow
;Now the mask image bits. We use GetDiBits_() for this.
bytesinrow = (mwidth+31)/32*4 ;Aligned to a 4-byte boundary.
bytesinrow * mheight
mem=AllocateMemory(bytesinrow)
*bitmapinfo\bmiHeader\biWidth=mwidth
*bitmapinfo\bmiHeader\biPlanes=1
*bitmapinfo\bmiHeader\biBitCount=1
If hbmColor
*bitmapinfo\bmiHeader\biHeight=mheight
GetDIBits_(hdc,hbmMask,0,mheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Else
*bitmapinfo\bmiHeader\biHeight=2*mheight
GetDIBits_(hdc,hbmMask,mheight,mheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
EndIf
WriteData(file, mem, bytesinrow)
FreeMemory(mem)
imagebytecount+bytesinrow
DeleteDC_(hdc)
;Finally, return to the field we missed out.
FileSeek(file, 14)
WriteLong(file, imagebytecount)
CloseFile(file)
result= 1 ;Signal everything is fine.
Else ;>
result= 0
EndIf;>
DeleteObject_(hbmMask) ;These are copies created as a result of GetIconInfo_() and so require deleting.
DeleteObject_(hbmColor)
FreeMemory(*bitmapinfo)
ProcedureReturn result
EndProcedure