#include once "window9.bi"

Using GDIPLUS

Dim shared ULONG_PTR_01 AS ULONG_PTR
DIM GDIPLUSSTARTUPINPUT_01 AS GDIPLUSSTARTUPINPUT
GDIPLUSSTARTUPINPUT_01.GdiplusVersion = 1
IF (GDIPLUSSTARTUP(@ULONG_PTR_01, @GDIPLUSSTARTUPINPUT_01, NULL) <> 0) THEN
	PRINT "FAIL"
End If

Function SaveIconOrCursor(byval hIcon As HICON, byref filename As USTRING) As Integer Export
	Dim  iconinfo As ICONINFO
	Dim As BITMAP cbitmap,mbitmap
	Dim As BITMAPINFO Ptr Tbitmapinfo
	Dim As Integer result, cwidth, cheight, cbitsperpixel, colorcount,_
	colorplanes,mwidth, mheight, fIcon, xHotspot, yHotspot, imagebytecount,_
	bytesinrow,temp
	Dim As Integer Ptr mem
	Dim As HBITMAP hbmMask, hbmColor
	Dim As HANDLE  file
	Dim As HDC hdc
	Dim As HGDIOBJ oldbitmap
	if len(filename) = 0 then return 0
	If GetIconInfo(hIcon, @iconinfo)=0 Then Return 0
	fIcon=2-iconinfo.fIcon 
	If fIcon=2 Then
		xHotspot=iconinfo.xHotspot
		yHotspot=iconinfo.yHotspot
	EndIf
	Tbitmapinfo = Callocate(SizeOf(BITMAPINFO) + SizeOf(RGBQUAD) Shl 8)
	If Tbitmapinfo = 0 Then Return 0
	hbmMask=iconinfo.hbmMask
	GetObject(hbmMask, SizeOf(BITMAP),@mbitmap)
	mwidth= mbitmap.bmWidth
	mheight= mbitmap.bmHeight
	hbmColor=iconinfo.hbmColor
	If hbmColor<>0 Then
		GetObject(hbmColor, SizeOf(BITMAP),@cbitmap)
		cwidth= cbitmap.bmWidth
		cheight= cbitmap.bmHeight
		cbitsperpixel = cbitmap.bmBitsPixel
		If cbitsperpixel = 0 then cbitsperpixel = 1
		If cbitsperpixel < 8 Then
			colorcount=2 ^ cbitsperpixel 
		EndIf
		colorplanes=cbitmap.bmplanes
	Else 
		cwidth= mwidth
		cheight= mheight/2
		cbitsperpixel = 1
		colorcount=2
		colorplanes=1
		mheight=cheight
	EndIf
	#ifdef UNICODE
		file=Create_File(*filename)
	#else	
		file=Create_File(filename)
	#EndIf
	If file<>cast(HANDLE,-1) Then
		Write_Word(file,0)
		Write_Word(file,ficon) 
		Write_Word(file,1)
		Write_Byte(file, cwidth)
		Write_Byte(file, cheight)
		Write_Byte(file, colorcount)
		Write_Byte(file, 0)
		If ficon=1 Then
			Write_Word(file, colorplanes)
			Write_Word(file, cbitsperpixel)
		Else
			Write_Word(file, xhotspot)
			Write_Word(file, yhotspot)
		EndIf
		Write_Integer(file,0)
		Write_integer(file,Get_File_Pointer(file)+4)
		imagebytecount=SizeOf(BITMAPINFOHEADER)
		Write_integer(file, imagebytecount)
		Write_Integer(file, cwidth)
		Write_Integer(file, cheight+mheight)
		Write_Word(file, colorplanes)
		Write_Word(file, cbitsperpixel)
		Write_Integer(file, 0)
		Write_Integer(file, 0)
		Write_Integer(file, 0)
		Write_Integer(file, 0)
		Write_Integer(file, 0)
		Write_Integer(file, 0)
		hdc=CreateCompatibleDC(0)
		If hbmColor = 0 Then
			Write_Integer(file, 0)
			Write_Integer(file, &hffffff)
			imagebytecount+=SizeOf(rgbquad)*2
		ElseIf cbitsperpixel<=8 Then
			temp=2 ^ cbitsperpixel
			bytesinrow = SizeOf(rgbquad)*temp
			mem=Callocate(bytesinrow)
			if mem then
				oldbitmap=SelectObject(hdc, hbmColor)
				GetDIBColorTable(hdc, 0, temp,Cast( RGBQUAD Ptr, mem))
				Write_Data(file, mem, bytesinrow)
				DeAllocate(mem)
				SelectObject(hdc, oldbitmap)
				imagebytecount+=bytesinrow
			endif
		EndIf
		bytesinrow = int((cwidth*cbitsperpixel+31)/32)*4
		bytesinrow *= cheight
		mem=Callocate(bytesinrow)
		if mem then
			Tbitmapinfo->bmiHeader.biSize=SizeOf(BITMAPINFOHEADER)
			Tbitmapinfo->bmiHeader.biWidth=cwidth
			Tbitmapinfo->bmiHeader.biPlanes=colorplanes
			Tbitmapinfo->bmiHeader.biBitCount=cbitsperpixel
			If hbmColor<>0 Then
				Tbitmapinfo->bmiHeader.biHeight=cheight
				GetDIBits(hdc,hbmColor,0,cheight,mem,Tbitmapinfo,DIB_RGB_COLORS)
			Else 
				Tbitmapinfo->bmiHeader.biHeight=cheight*2
				GetDIBits(hdc,hbmMask,0,cheight,mem,Tbitmapinfo,DIB_RGB_COLORS)
			EndIf
			Write_Data(file,mem, bytesinrow)
			DeAllocate(mem)
			imagebytecount+=bytesinrow
		endif
		bytesinrow = int((mwidth+31)/32)*4
		bytesinrow *=mheight
		mem=Callocate(bytesinrow)
		if mem then
			Tbitmapinfo->bmiHeader.biWidth=mwidth
			Tbitmapinfo->bmiHeader.biPlanes=1
			Tbitmapinfo->bmiHeader.biBitCount=1
			If hbmColor<>0 Then
				Tbitmapinfo->bmiHeader.biHeight=mheight
				GetDIBits(hdc,hbmMask,0,mheight,mem,Tbitmapinfo,DIB_RGB_COLORS)
			Else
				Tbitmapinfo->bmiHeader.biHeight=mheight*2
				GetDIBits(hdc,hbmMask,mheight,mheight,mem,Tbitmapinfo,DIB_RGB_COLORS)
			EndIf
			Write_Data(file,mem, bytesinrow)
			DeAllocate(mem)
			imagebytecount+=bytesinrow
		endif
		DeleteDC(hdc)
		Set_File_Pointer(file, 14,FILE_BEGIN )
		Write_Integer(file, imagebytecount)
		Close_File(file)
		result= 1
	Else
		result= 0
	EndIf
	DeleteObject(hbmMask)
	DeleteObject(hbmColor)
	DeAllocate(Tbitmapinfo)
	Return result
End Function

Function CreateIconOrCursorFromGpBitmap(ByVal pBitmap As Any Ptr) As HICON Export
	Dim As HICON hIcon
	GdipCreateHICONFromBitmap(pBitmap, @hIcon)
	Return hIcon
End Function

Function CreateIconOrCursorFromBitmap(ByVal hBmp As HBITMAP) As HICON Export
	Dim As GpBitmap Ptr pBitmap
	Dim As HICON hIcon
	GdipCreateBitmapFromHBITMAP(hBmp, NULL, @pBitmap)
	GdipCreateHICONFromBitmap(pBitmap, @hIcon)
	GdipDisposeImage(Cast(GpImage Ptr, pBitmap))
	Return hIcon
End Function

#ifdef UNICODE
	Function CreateIconOrCursorFromFile(ByRef sFileName As USTRING) As HICON Export
		Dim As GpBitmap Ptr pBitmap
		Dim As HICON hIcon
		GdipCreateBitmapFromFile(*sFileName, @pBitmap)
		GdipCreateHICONFromBitmap(pBitmap, @hIcon)
		GdipDisposeImage(Cast(GpImage Ptr, pBitmap))
		Return hIcon
	End Function
#ELSE
	Function CreateIconOrCursorFromFile(ByRef sFileName As USTRING) As HICON Export
		Dim As GpBitmap Ptr pBitmap
		Dim As HICON hIcon
		Dim As WString Ptr tString = ASCIITOUTF(sFileName)
		if tString = 0 then return 0
		GdipCreateBitmapFromFile(tString, @pBitmap)
		GdipCreateHICONFromBitmap(pBitmap, @hIcon)
		GdipDisposeImage(Cast(GpImage Ptr, pBitmap))
		DeAllocate(tString)
		Return hIcon
	End Function
#ENDIF
