And NM knowledge
- You can create Icon with different size and color from Any Bit Mapped format Image
- You can create Black & White cursor also
- Transparent color for now is WHITE
- Adapt it for your needs
have fun
Code: Select all
UsePNGImageEncoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseJPEGImageDecoder()
;http://www.purebasic.fr/english/viewtopic.php?p=159048#159048
;SaveIcon(hIcon, filename$)
;By Stephen Rodriguez 2006 (Updated 2010).
crossHnd = LoadCursor_(0, #IDC_CROSS )
arrowHnd = LoadCursor_(0, #IDC_ARROW )
Procedure.i SaveIcon(hIcon, filename$)
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
Procedure GrayScaleImg(Img)
StartDrawing(ImageOutput(Img))
Width = ImageWidth(Img) - 1
Height = ImageHeight(Img) - 1
For y = 0 To Height
For x = 0 To Width
Pixel = Point(x, y)
Gray = Red(Pixel) * 77 ; 0.2989 * 256 = 76.5184
Gray + Green(Pixel) * 150 ; 0.5870 * 256 = 150.2720
Gray + Blue(Pixel) * 29 ; 0.1140 * 256 = 29.1840
Gray = Gray >> 8 ; / 256
Plot(x, y, RGB(Gray, Gray, Gray))
Next x
Next y
StopDrawing()
ProcedureReturn #True
EndProcedure
OpenWindow(0,0,0,250,290,"Icon - Cursor Creator",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OptionGadget(1,10,10,100,22," 16 x 16")
OptionGadget(2,10,35,100,22," 24 x 24")
OptionGadget(3,10,60,100,22," 32 x 32")
OptionGadget(4,10,85,100,22," 48 x 48")
OptionGadget(5,10,110,100,22," 64 x 64")
OptionGadget(6,10,135,100,22," 128 x 128")
OptionGadget(7,10,160,100,22," Custom Size")
DisableGadget(7,1)
SetGadgetState(6,1)
StringGadget(8,135,160,30,22,"",#PB_String_Numeric)
StringGadget(9,175,160,30,22,"",#PB_String_Numeric)
DisableGadget(8,1)
DisableGadget(9,1)
CheckBoxGadget(10,60,195,50,22," Color")
OptionGadget(11,10,195,50,22," Icon")
OptionGadget(12,10,220,50,22," Cursor")
SetGadgetState(10,1)
ContainerGadget(13,110,10,128,128, #PB_Container_BorderLess)
ButtonImageGadget(14,-1,-1,130,130,0)
CloseGadgetList()
DisableGadget(13,1)
ButtonGadget(15,10,260,75,22,"Load Image")
ButtonGadget(16,95,260,75,22,"Save As...")
ButtonGadget(17,180,260,63,22,"EXIT")
TextGadget(18,120,195,22,22,"",#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER| #SS_NOTIFY)
TextGadget(19,150,195,90,22,"Transparent Color",#SS_CENTERIMAGE)
SetGadgetColor(18,#PB_Gadget_BackColor,#White)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit =1
Case #WM_MOUSEMOVE
If ChildWindowFromPoint_(WindowID(0),WindowMouseY(0) << 32 + WindowMouseX(0)) = GadgetID(13)
Flag = 1
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR,crossHnd)
Else
Flag = 0
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR,arrowHnd)
EndIf
Case #WM_LBUTTONDOWN
If Flag = 1 And IsImage(0)
StartDrawing(WindowOutput(0))
color = Point(WindowMouseX(0),WindowMouseY(0))
StopDrawing()
SetGadgetColor(18,#PB_Gadget_BackColor,Color )
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 10
If IsImage(0) <> 0 And GetGadgetState(12) = 0
If GetGadgetState(10) = 0
CopyImage(0, 1)
ResizeImage(1,Size,Size)
GrayScaleImg(1)
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
Else
CopyImage(0, 1)
ResizeImage(1,Size,Size)
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Else
SetGadgetState(10,0)
EndIf
Case 12
SetGadgetState(10,0)
If IsImage(0)
CopyImage(0, 1)
ResizeImage(1,Size,Size)
GrayScaleImg(1)
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Case 1 To 6
For x = 1 To 6
If GetGadgetState(x) = 1
Break
EndIf
Next
If x = 1
Size = 16
ElseIf x = 2
Size = 24
ElseIf x = 3
Size = 32
ElseIf x = 4
Size = 48
ElseIf x = 5
Size = 64
ElseIf x = 6
Size = 128
EndIf
If IsImage(0)
CopyImage(0, 1)
ResizeImage(1,Size,Size)
If GetGadgetState(10) = 0
GrayScaleImg(1)
EndIf
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Case 15
File$ = OpenFileRequester("Raw Image", "*.bmp","bmp (*.bmp)| *.bmp| jpg (*.jpg)| *.jpg| tif (*.tif)| *.tif| png (*.png)| *.png| tga (*.tga)|*.tga,| All files (*.*)| *.*",0)
If File$
LoadImage(0,File$)
For x = 1 To 6
If GetGadgetState(x) = 1
Break
EndIf
Next
If x = 1
Size = 16
ElseIf x = 2
Size = 24
ElseIf x = 3
Size = 32
ElseIf x = 4
Size = 48
ElseIf x = 5
Size = 64
ElseIf x = 6
Size = 128
EndIf
CopyImage(0, 1)
ResizeImage(1,Size,Size)
If GetGadgetState(10) = 0
GrayScaleImg(1)
EndIf
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Case 16
sFile$ = SaveFileRequester("Please choose file to save",""," Icon file (*.ico)|*.ico| Cursor file (*.cur)|*.cur",0)
If sFile$
CreateImage(2, Size,Size)
StartDrawing(ImageOutput(2))
If GetGadgetState(11) = 1
DrawingMode(#PB_2DDrawing_AllChannels )
Else
DrawingMode(#PB_2DDrawing_AlphaChannel )
EndIf
DrawImage(ImageID(1),0,0)
StopDrawing()
iinf.ICONINFO
If GetGadgetState(11) = 1
iinf\fIcon = 1
iinf\hbmMask = ImageID(1)
iinf\hbmColor = ImageID(2)
icoHnd = CreateIconIndirect_(iinf)
sFile$ = GetPathPart(sFile$) + GetFilePart(sFile$,1) + ".ico"
SaveIcon(icoHnd, sFile$)
Else
iinf\fIcon = 0
iinf\xHotspot = Size/2
iinf\yHotspot = Size/2
iinf\hbmMask = ImageID(1)
iinf\hbmColor = ImageID(2)
curHnd = CreateIconIndirect_(iinf)
sFile$ = GetPathPart(sFile$) + GetFilePart(sFile$,1) + ".cur"
SaveIcon(curHnd, sFile$)
EndIf
EndIf
Case 17
End
EndSelect
EndSelect
Until Quit = 1
End