PureBasic Forums - English

Code: Select all

DeclareModule Icon
	
	Enumeration
		#Icon_Icon   = 1
		#Icon_Cursor = 2
	EndEnumeration
	
	Declare.i IconID(Icon.i)
	Declare.i IsIcon(Icon.i)
	Declare.i FreeIcon(Icon.i)
	Declare.i CreateIcon(Icon.i)
	Declare AddIconImage(Icon.i, Image.i)
	Declare IconImage(Icon.i, Size.i)
	Declare IconImageID(Icon.i, Size.i)
	Declare SaveIcon(Icon.i, FileName.s, Format.i=#Icon_Icon, HotSpotX.i=0, HotSpotY.i=0)
	
EndDeclareModule



Module Icon



#IndexNumber  = $FFFF
#AnyNumber    = ~#IndexNumber

Structure IconLayer
	Image.i
	FileOffset.i
EndStructure

Structure Icon
	Number.i
	List Layer.IconLayer()
EndStructure

Structure IconInclude
	List		Icon.Icon()
	Array		*IconID.Icon(0)
EndStructure



Global IconInclude.IconInclude



Procedure.i IconID(Icon.i)
	
	If Icon & #AnyNumber
		ProcedureReturn Icon
	Else
		ProcedureReturn IconInclude\IconID(Icon)
	EndIf
	
EndProcedure



Procedure.i IsIcon(Icon.i)
	
	ForEach IconInclude\Icon()
		If IconInclude\Icon()\Number = Icon
			ProcedureReturn @IconInclude\Icon()
		EndIf
	Next
	
EndProcedure



Procedure.i FreeIcon(Icon.i)
	
	Protected *Icon.Icon = IconID(Icon)
	
	With *Icon
		
		ForEach \Layer()
			FreeImage(\Layer()\Image)
		Next
		
		If Not \Number & #AnyNumber
			IconInclude\IconID(\Number) = #Null
		EndIf
		
		ChangeCurrentElement(IconInclude\Icon(), *Icon)
		DeleteElement(IconInclude\Icon())
		
	EndWith
	
EndProcedure



Procedure.i CreateIcon(Icon.i)
	
	Protected *Icon.Icon
	
	If Icon = #PB_Any
		*Icon = AddElement(IconInclude\Icon())
		*Icon\Number = *Icon
	ElseIf Not Icon & #AnyNumber
		*Icon = AddElement(IconInclude\Icon())
		*Icon\Number = Icon
		If ArraySize(IconInclude\IconID()) < Icon 
			ReDim IconInclude\IconID(Icon)
		ElseIf IconInclude\IconID(Icon)
			FreeIcon(IconInclude\IconID(Icon))
		EndIf
		IconInclude\IconID(Icon) = *Icon
	Else
		ProcedureReturn #Null
	EndIf
	
	ProcedureReturn *Icon
	
EndProcedure



Procedure AddIconImage(Icon.i, Image.i)
	
	Protected *Icon.Icon = IconID(Icon)
	
	AddElement(*Icon\Layer())
	*Icon\Layer()\Image  = CopyImage(Image, #PB_Any)
	
EndProcedure



Procedure IconImage(Icon.i, Size.i)
	
	Protected *Icon.Icon = IconID(Icon)
	
	ForEach *Icon\Layer()
		If ImageWidth(*Icon\Layer()\Image) = Size
			ProcedureReturn *Icon\Layer()\Image
		EndIf
	Next
	
EndProcedure



Procedure IconImageID(Icon.i, Size.i)
	
	ProcedureReturn ImageID(IconImage(Icon, Size))
	
EndProcedure



Procedure Icon_WriteImage(File.i, Image.i)
	
	Protected Color
	Protected BitmapInfoHeader.BITMAPINFOHEADER
	
	With BitmapInfoHeader
		\biSize     = SizeOf(BITMAPINFOHEADER)
		\biWidth    = ImageWidth(Image)
		\biHeight   = ImageHeight(Image)*2
		\biPlanes   = 1
		\biBitCount = 32
	EndWith
	WriteData(File, BitmapInfoHeader, SizeOf(BitmapInfoHeader))
	If StartDrawing(ImageOutput(Image))
		DrawingMode(#PB_2DDrawing_AllChannels)
		For Y = ImageHeight(Image)-1 To 0 Step -1
			For X = 0 To ImageWidth(Image)-1
				Color = Point(X, Y)
				WriteLong(File, Color&$FF00FF00|((Color&$FF)<<16)|((Color>>16)&$FF))
			Next
		Next
		StopDrawing()
	EndIf
	
EndProcedure



Procedure SaveIcon(Icon.i, FileName.s, Format.i=#Icon_Icon, HotSpotX.i=0, HotSpotY.i=0)
	
	Protected *Icon.Icon = IconID(Icon)
	Protected File.i = CreateFile(#PB_Any, FileName)
	Protected *Buffer
	
	With *Icon
		If File
			WriteWord(File, 0) ; Reserved
			WriteWord(File, Format) ; Image type
			WriteWord(File, ListSize(\Layer())) ; Number of images
			; Layer List
			ForEach \Layer()
				WriteAsciiCharacter(File, ImageWidth(\Layer()\Image)) ; Width
				WriteAsciiCharacter(File, ImageHeight(\Layer()\Image)) ; Height
				WriteAsciiCharacter(File, 0) ; Colors
				WriteAsciiCharacter(File, 0) ; Reserved
				If Format = #Icon_Cursor
					WriteWord(File, HotSpotX) ; Color planes
					WriteWord(File, HotSpotY) ; Bits per pixel
				Else
					WriteWord(File, 1) ; Color planes
					WriteWord(File, 32) ; Bits per pixel
				EndIf
				WriteLong(File, SizeOf(BITMAPINFOHEADER)+ImageWidth(\Layer()\Image)*ImageHeight(\Layer()\Image)*4)
				\Layer()\FileOffset = Loc(File)
				WriteLong(File, 0)
			Next
			; Datas
			ForEach \Layer()
				FileSeek(File, \Layer()\FileOffset)
				WriteLong(File, Lof(File))
				FileSeek(File, Lof(File))
				Icon_WriteImage(File, \Layer()\Image)
			Next
			CloseFile(File)
		EndIf
	EndWith
	
EndProcedure



EndModule



CompilerIf #PB_Compiler_IsMainFile
	
	UseModule Icon
	
	Enumeration
		#Icon
	EndEnumeration
	
	UsePNGImageDecoder()
	
	If CreateIcon(#Icon)
		AddIconImage(#Icon, LoadImage(#PB_Any, "dvd16.png")) ; use your own path!
		AddIconImage(#Icon, LoadImage(#PB_Any, "dvd32.png")) ; use your own path!
		SaveIcon(#Icon, "dvd.ico")
	EndIf
	
CompilerEndIf