Windows seulement, x64, x86 de Windosws Xp à Windows 10, et probablement 11 (pas testé).
[Edition 28/10/2024] Bug dans la sauvegarde, ajout d'un code de srod pour enregistrer en ico et cur et modif de "ExtractIcons.xml.dd.pbi".
YAIG.pb
Code : Tout sélectionner
;- TOP
;-
;- YAIG: Yet Another Icon Grabber
;From this original code: https://www.purebasic.fr/english/viewtopic.php?p=417143#p417143
;-
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
;- Include
XIncludeFile "ExtractIcons.xml.dd.pbi"
;- Global
Global iSize = 266; zoom image size
Structure Slist_listicon
id.i
w.i
h.i
bpp.i
EndStructure
Global NewList List_listicon.Slist_listicon(); list of image handles
;-
;- ######## ICON CODE ################
; http://msdn.microsoft.com/en-us/library/ms997538.aspx
;- Constant
Enumeration
#Icon_GetSclHdl ; Icon might be scaled (in case a 256Pixel is requested and only 16Pixel is available, it's scaled)
#Icon_GetCnt ; How many different Icons are available
#Icon_GetRealHdl ; Get real icon - nothing is scaled! In case there's no fitting Icon you'll get nothing
#Icon_GetSizes ; Get List of available Icon Sizes
EndEnumeration
;- Structure
Structure Icon_Dimension
Width.i ; Width
Height.i ; Height
BitCnt.a ; Bits per pixel: 1=2 Colors, 2=4 Colors, 4=16 Colors, 8=256 Colors, 24=TrueColor, 32=TrueColor+Alpha
EndStructure
Structure Icon_Size
Array Icon_Size.Icon_Dimension(1)
EndStructure
Structure Icon_EnumData
Mode.i ; what kind of data we'd like to get
Nr.i ; which Icon we'd like to get (1=first, 2=second, ..)
RetVal.i; return value with the requested information
Array Size.Icon_Dimension(1) ; size of the icon we want or it holds the sizes of all available icons
EndStructure
Structure ICONDIRENTRY
bWidth.a ; Width, in pixels, of the image
bHeight.a ; Height, in pixels, of the image
bColorCount.a ; Number of colors in image (0 if >=8bpp)
bReserved.a ; Reserved ( must be 0)
wPlanes.w ; Color Planes
wBitCount.w ; Bits per pixel
dwBytesInRes.l ; How many bytes in this resource?
dwImageOffset.l; Where in the file is this image?
EndStructure
Structure ICONDIR
idReserved.w ; Reserved (must be 0)
idType.w ; Resource Type (1 for icons)
idCount.w ; How many images?
Array idEntries.ICONDIRENTRY(1) ;An entry for each image (idCount of 'em)
EndStructure
;- Private Procedure
Procedure __Icon_EnumCallback(hLibrary, lpszType, lpszName, *Data.Icon_EnumData)
; 20130707..nalor..implemented support for icons with low BPP (1,2,4)
Protected hIcon.i
Protected hRsrc.i
Protected hGlobal.i
Protected Cnt.i
Protected *GrpIconDir.GRPICONDIR
Protected *IconImage.ICONIMAGE
Protected Colors.a
Select *Data\Mode
Case #Icon_GetCnt
*Data\RetVal + 1
Case #Icon_GetSclHdl
*Data\RetVal + 1
If *Data\Nr = *Data\RetVal ; we've reached the requested Icon
*Data\RetVal = LoadImage_(hLibrary, lpszName, #IMAGE_ICON, *Data\Size(0)\Width, *Data\Size(0)\Height, 0)
ProcedureReturn #False ; no need to continue enumerating
EndIf
Case #Icon_GetSizes
*Data\RetVal + 1
If *Data\Nr = *Data\RetVal ; we've reached the requested Icon
;Find the group resource which lists its images
hRsrc = FindResource_(hLibrary, lpszName, lpszType)
If hRsrc
;Load And Lock To get a pointer To a GRPICONDIR
hGlobal = LoadResource_(hLibrary, hRsrc)
If hGlobal
*GrpIconDir = LockResource_(hGlobal)
If *GrpIconDir
If *GrpIconDir\idCount
ReDim *Data\Size(*GrpIconDir\idCount - 1)
EndIf
For Cnt = 0 To *GrpIconDir\idCount - 1
*Data\Size(Cnt)\Width = PeekA(@*GrpIconDir\idEntries[Cnt]\bWidth) ; peeka is used because 'Byte' is signed and we want an unsigned result
*Data\Size(Cnt)\Height = PeekA(@*GrpIconDir\idEntries[Cnt]\bHeight)
If *Data\Size(Cnt)\Height = 0
*Data\Size(Cnt)\Height = 256
EndIf
If *Data\Size(Cnt)\Width = 0
*Data\Size(Cnt)\Width = 256
EndIf
Select *GrpIconDir\idEntries[Cnt]\bColorCount
Case 0 ; it's an icon with at least 256 colors
*Data\Size(Cnt)\BitCnt = *GrpIconDir\idEntries[Cnt]\wBitCount
Case 2
*Data\Size(Cnt)\BitCnt = 1
Case 4
*Data\Size(Cnt)\BitCnt = 2
Case 16
*Data\Size(Cnt)\BitCnt = 4
EndSelect
;Debug "Callback Cnt >"+Str(Cnt+1)+"< Size >"+Str(*Data\Size(Cnt)\Width)+" x "+Str(*Data\Size(Cnt)\Height)+"< Col >"+Str(*Data\Size(Cnt)\BitCnt)+"<"
Next
Else
*Data\RetVal = - 3
EndIf
Else
*Data\RetVal = - 2
EndIf
Else
*Data\RetVal = - 1
EndIf
ProcedureReturn #False ; no need to continue enumerating
EndIf
Case #Icon_GetRealHdl
Select *Data\Size(0)\BitCnt
Case 1
Colors = 2
Case 2
Colors = 4
Case 4
Colors = 16
Default
Colors = 1 ; an impossible value
EndSelect
*Data\RetVal + 1
; Debug "Current IconNr >"+Str(*Data\RetVal)+"< Dest >"+Str(*Data\Nr)+"<"
If *Data\Nr = *Data\RetVal ; we've reached the requested Icon
; http://msdn.microsoft.com/en-us/library/ms997538.aspx
;Find the group resource which lists its images
hRsrc = FindResource_(hLibrary, lpszName, lpszType)
If hRsrc
;Load And Lock To get a pointer To a GRPICONDIR
hGlobal = LoadResource_(hLibrary, hRsrc)
If hGlobal
*GrpIconDir = LockResource_(hGlobal)
If *GrpIconDir
; Using an ID from the group, Find, Load And Lock the RT_ICON
*Data\RetVal = 0 ; in case the requested icon is not available, "0" will be the return value
For Cnt = 0 To *GrpIconDir\idCount - 1
If PeekA(@*GrpIconDir\idEntries[Cnt]\bWidth) = *Data\Size(0)\Width And
PeekA(@*GrpIconDir\idEntries[Cnt]\bHeight) = *Data\Size(0)\Height And
(*GrpIconDir\idEntries[Cnt]\wBitCount = *Data\Size(0)\BitCnt Or *Data\Size(0)\BitCnt = 0 Or *GrpIconDir\idEntries[Cnt]\bColorCount = Colors)
hRsrc = FindResource_(hLibrary, *GrpIconDir\idEntries[Cnt]\nID, #RT_ICON)
If hRsrc
hGlobal = LoadResource_(hLibrary, hRsrc)
If hGlobal
*IconImage = LockResource_(hGlobal) ;Here, *IconImage points To an ICONIMAGE Structure
If *IconImage
*Data\RetVal = CreateIconFromResourceEx_(*IconImage, SizeofResource_(hLibrary, hRsrc), #True, $30000, 0, 0, 0)
Else
*Data\RetVal = - 6
EndIf
Else
*Data\RetVal = - 5
EndIf
Else
*Data\RetVal = - 4
EndIf
ProcedureReturn #False ; we found the specific icon
EndIf
Next
Else
*Data\RetVal = - 3
EndIf
Else
*Data\RetVal = - 2
EndIf
Else
*Data\RetVal = - 1
EndIf
ProcedureReturn #False ; no need to continue enumerating
EndIf
EndSelect
ProcedureReturn #True
EndProcedure
Procedure.i __Icon_GetRealHdlICO(File.s, Width.i, Height.i, BPP.a = 0)
Protected pIconDir.ICONDIR ;We need an ICONDIR To hold the Data
Protected *IconImage.ICONIMAGE
Protected FileHdl.i
Protected Cnt.i
Protected Colors.a
Protected RetVal.i = 0
Select BPP
Case 1
Colors = 2
Case 2
Colors = 4
Case 4
Colors = 16
Default
Colors = 1 ; an impossible value
EndSelect
FileHdl = ReadFile(#PB_Any, File)
If FileHdl
pIconDir\idReserved = ReadWord(FileHdl) ; Read the Reserved word
pIconDir\idType = ReadWord(FileHdl) ; Read the Type word - make sure it is 1 For icons
If (pIconDir\idType = #IMAGE_ICON Or pIconDir\idType = #IMAGE_CURSOR) ; it's an Icon or a Cursor
pIconDir\idCount = ReadWord(FileHdl) ; Read the count - how many images in this file?
ReDim pIconDir\idEntries(pIconDir\idCount - 1) ; Reallocate IconDir so that idEntries has enough room For idCount elements
If ReadData(FileHdl, @pIconDir\idEntries(0), SizeOf(ICONDIRENTRY) * pIconDir\idCount) ; Read the ICONDIRENTRY elements
RetVal = 0
For Cnt = 0 To pIconDir\idCount - 1
;Debug "CurIcon >"+Str(pIconDir\idEntries(Cnt)\bWidth)+"<>"+Str(pIconDir\idEntries(Cnt)\bHeight)+"<>"+Str(pIconDir\idEntries(Cnt)\wBitCount)+"<"
If PeekA(@pIconDir\idEntries(Cnt)\bWidth) = Width And
PeekA(@pIconDir\idEntries(Cnt)\bHeight) = Height And
(pIconDir\idEntries(Cnt)\wBitCount = BPP Or BPP = 0 Or pIconDir\idEntries(Cnt)\bColorCount = Colors)
*IconImage = AllocateMemory(pIconDir\idEntries(Cnt)\dwBytesInRes) ; Allocate memory To hold the image
If *IconImage
FileSeek(FileHdl, pIconDir\idEntries(Cnt)\dwImageOffset) ; Seek To the location in the file that has the image
If ReadData(FileHdl, *IconImage, pIconDir\idEntries(Cnt)\dwBytesInRes) ;Read the image Data
RetVal = CreateIconFromResourceEx_(*IconImage, pIconDir\idEntries(Cnt)\dwBytesInRes, #True, $30000, 0, 0, 0)
Else
Debug "ERROR!! Reading ICONIMAGE data (__Icon_GetRealHdlICO)"
RetVal = - 5
EndIf
FreeMemory(*IconImage)
Break;
Else
Debug "ERROR!! Allocating Memory (__Icon_GetRealHdlICO)"
RetVal = - 4
EndIf
EndIf
Next
Else
Debug "ERROR!! Reading ICONDIRENTRY data (__Icon_GetRealHdlICO)"
RetVal = - 3
EndIf
Else
Debug "ERROR!! it's not an icon or a cursor (__Icon_GetRealHdlICO)"
RetVal = - 2
EndIf
CloseFile(FileHdl)
Else
Debug "ERROR!! reading file (__Icon_GetRealHdlICO)"
RetVal = - 1
EndIf
ProcedureReturn RetVal
EndProcedure
Procedure.i __Icon_GetSizesICO(File.s, *Sizes.Icon_Size)
; 20130707..nalor..implemented support for icons with low BPP (1,2,4)
Protected pIconDir.ICONDIR ;We need an ICONDIR To hold the Data
Protected FileHdl.i
Protected Cnt.i
Protected RetVal.i = 0
FileHdl = ReadFile(#PB_Any, File)
If FileHdl
pIconDir\idReserved = ReadWord(FileHdl) ; Read the Reserved word
pIconDir\idType = ReadWord(FileHdl) ; Read the Type word - make sure it is 1 For icons
If (pIconDir\idType = #IMAGE_ICON Or pIconDir\idType = #IMAGE_CURSOR) ; it's an Icon or a Cursor
pIconDir\idCount = ReadWord(FileHdl) ; Read the count - how many images in this file?
ReDim pIconDir\idEntries(pIconDir\idCount - 1) ; Reallocate IconDir so that idEntries has enough room For idCount elements
If ReadData(FileHdl, @pIconDir\idEntries(0), SizeOf(ICONDIRENTRY) * pIconDir\idCount) ; Read the ICONDIRENTRY elements
ReDim *Sizes\Icon_Size(pIconDir\idCount - 1)
For Cnt = 0 To pIconDir\idCount - 1
*Sizes\Icon_Size(Cnt)\Width = PeekA(@pIconDir\idEntries(Cnt)\bWidth) ; peeka is used because 'Byte' is signed and we want an unsigned result
*Sizes\Icon_Size(Cnt)\Height = PeekA(@pIconDir\idEntries(Cnt)\bHeight)
If *Sizes\Icon_Size(Cnt)\Width = 0
*Sizes\Icon_Size(Cnt)\Width = 256
EndIf
If *Sizes\Icon_Size(Cnt)\Height = 0
*Sizes\Icon_Size(Cnt)\Height = 256
EndIf
Select pIconDir\idEntries(Cnt)\bColorCount
Case 0 ; it's an icon with at least 256 colors
*Sizes\Icon_Size(Cnt)\BitCnt = pIconDir\idEntries(Cnt)\wBitCount
Case 2
*Sizes\Icon_Size(Cnt)\BitCnt = 1
Case 4
*Sizes\Icon_Size(Cnt)\BitCnt = 2
Case 16
*Sizes\Icon_Size(Cnt)\BitCnt = 4
EndSelect
Debug "__Icon_GetSizesICO Cnt >" + Str(Cnt + 1) + "/" + Str(pIconDir\idCount) + "< Size >" + Str(*Sizes\Icon_Size(Cnt)\Width) + " x " + Str(*Sizes\Icon_Size(Cnt)\Height) + "< BitCnt >" + Str(*Sizes\Icon_Size(Cnt)\BitCnt) + "<"
Next
RetVal = 1
Else
Debug "ERROR!! Reading ICONDIRENTRY data (__Icon_GetSizesICO)"
RetVal = - 3
EndIf
Else
Debug "ERROR!! it's not an icon or a cursor (__Icon_GetSizesICO)"
RetVal = - 2
EndIf
CloseFile(FileHdl)
Else
Debug "ERROR!! reading file (__Icon_GetSizesICO)"
RetVal = - 1
EndIf
ProcedureReturn RetVal
EndProcedure
;- Public Procedure
Procedure.i Icon_GetSizes(File.s, *Sizes.Icon_Size, IconNr.i = 1)
Protected IconData.Icon_EnumData
Protected hLibrary.i
Protected ImgHdl.i
IconData\RetVal = 0
Select LCase(GetExtensionPart(File))
Case "ico", "cur"
IconData\RetVal = __Icon_GetSizesICO(File, *Sizes)
; Debug "Sizes >" + ArraySize(*Sizes\Icon_Size()) + "<"
; Debug "Width >" + Str(*Sizes\Icon_Size(0)\Height) + "<"
Case "bmp"
ImgHdl = LoadImage(#PB_Any, File)
If ImgHdl
ReDim *Sizes\Icon_Size(0)
*Sizes\Icon_Size(0)\Height = ImageHeight(ImgHdl)
*Sizes\Icon_Size(0)\Width = ImageWidth(ImgHdl)
*Sizes\Icon_Size(0)\BitCnt = ImageDepth(ImgHdl, #PB_Image_OriginalDepth)
FreeImage(ImgHdl)
Else
Debug "ERROR!! Loading File (Icon_GetSizes)"
IconData\RetVal = - 1
EndIf
Case "exe", "dll"
hLibrary = LoadLibraryEx_(File, #Null, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary
IconData\Mode = #Icon_GetSizes
IconData\Nr = IconNr
EnumResourceNames_(hLibrary, #RT_GROUP_ICON, @__Icon_EnumCallback(), @IconData)
FreeLibrary_(hLibrary)
If IconData\RetVal ; detection of sizes succesfull
If CopyArray(IconData\Size(), *Sizes\Icon_Size())
IconData\RetVal = #True
Else
Debug "Error CopyArray"
IconData\RetVal = #False
EndIf
Else
IconData\RetVal = #False
Debug "Error Callback (Icon_GetSizes)"
EndIf
EndIf
EndSelect
ProcedureReturn IconData\RetVal
EndProcedure
Procedure.i Icon_GetHdl(File.s, Width.i = 16, IconNr.i = 1, Height.i = 0)
Protected IconData.Icon_EnumData
Protected hLibrary.i
If Height = 0
Height = Width
EndIf
Select LCase(GetExtensionPart(File))
Case "ico"
IconData\RetVal = LoadImage_(#Null, @File, #IMAGE_ICON, Width, Height, #LR_LOADFROMFILE)
Case "cur"
IconData\RetVal = LoadImage_(#Null, @File, #IMAGE_CURSOR, Width, Height, #LR_LOADFROMFILE)
Case "bmp"
IconData\RetVal = LoadImage_(#Null, @File, #IMAGE_BITMAP, Width, Height, #LR_LOADFROMFILE)
Case "exe", "dll"
hLibrary = LoadLibraryEx_(File, #Null, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary
IconData\RetVal = 0
IconData\Size(0)\Width = Width
IconData\Size(0)\Height = Height
IconData\Nr = IconNr
IconData\Mode = #Icon_GetSclHdl
EnumResourceNames_(hLibrary, #RT_GROUP_ICON, @__Icon_EnumCallback(), @IconData)
FreeLibrary_(hLibrary)
EndIf
Default
IconData\RetVal = 0
EndSelect
ProcedureReturn IconData\RetVal
EndProcedure
Procedure.i Icon_GetRealHdl(File.s, Width.i = 16, IconNr.i = 1, Height.i = 0, BPP.a = 0)
Protected IconData.Icon_EnumData
Protected hLibrary.i
Protected ImgHdl.i
If Width = 256 And LCase(GetExtensionPart(File)) <> "bmp" ; this rule is not for BMP files!
Width = 0 ; Width256 is stored as 0 (because it's only 1 Byte, so 255 is max.)
EndIf
If Height = 0 Or Height = 256
Height = Width
EndIf
IconData\RetVal = 0
Select LCase(GetExtensionPart(File))
Case "ico", "cur"
IconData\RetVal = __Icon_GetRealHdlICO(File, Width, Height, BPP)
Case "bmp"
ImgHdl = LoadImage(#PB_Any, File)
If ImgHdl
If ImageHeight(ImgHdl) = Height And
ImageWidth(ImgHdl) = Width And
(ImageDepth(ImgHdl, #PB_Image_OriginalDepth) = BPP Or BPP = 0)
IconData\RetVal = Icon_GetHdl(File, Width, 1, Height)
Else
Debug "BMP size is not available"
IconData\RetVal = 0
EndIf
FreeImage(ImgHdl)
Else
Debug "ERROR!! Loading File (Icon_GetSizes)"
IconData\RetVal = - 1
EndIf
Case "exe", "dll"
hLibrary = LoadLibraryEx_(File, #Null, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary
IconData\Mode = #Icon_GetRealHdl
IconData\Nr = IconNr
IconData\Size(0)\Width = Width
IconData\Size(0)\Height = Height
IconData\Size(0)\BitCnt = BPP
EnumResourceNames_(hLibrary, #RT_GROUP_ICON, @__Icon_EnumCallback(), @IconData)
FreeLibrary_(hLibrary)
EndIf
EndSelect
ProcedureReturn IconData\RetVal
EndProcedure
Procedure.i Icon_GetCnt(File.s)
Protected IconData.Icon_EnumData
Protected hLibrary.i
Select LCase(GetExtensionPart(File))
Case "exe", "dll"
IconData\Mode = #Icon_GetCnt
IconData\RetVal = 0
hLibrary = LoadLibraryEx_(File, #Null, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary
EnumResourceNames_(hLibrary, #RT_GROUP_ICON, @__Icon_EnumCallback(), @IconData)
FreeLibrary_(hLibrary)
EndIf
Case "ico", "cur", "bmp"
IconData\RetVal = 1
Default
IconData\RetVal = - 1 ; File not supported
EndSelect
ProcedureReturn IconData\RetVal
EndProcedure
Procedure Icon_DestroyHdl(hIcon.i)
DestroyIcon_(hIcon)
EndProcedure
Procedure Icon_GetInfo(hIcon.i, *Size.Icon_Dimension)
; http://stackoverflow.com/questions/1913468/how-to-determine-the-size-of-an-icon-from-a-hicon
Protected IconInf.ICONINFO
Protected BMInf.BITMAP
Protected RetVal.i = 1
If (GetIconInfo_(hIcon, IconInf))
If (IconInf\hbmColor) ; ' Icon has colour plane
If (GetObject_(IconInf\hbmColor, SizeOf(BITMAP), @BMInf))
*Size\Width = BMInf\bmWidth
*Size\Height = BMInf\bmHeight
*Size\BitCnt = BMInf\bmBitsPixel
DeleteObject_(IconInf\hbmColor)
Else
RetVal = - 3
Debug "ERROR!! GetObject failed (Icon_GetInfo)"
EndIf
Else ;' Icon has no colour plane, image data stored in mask
If (GetObject_(IconInf\hbmMask, SizeOf(BITMAP), @BMInf))
*Size\Width = BMInf\bmWidth
*Size\Height = BMInf\bmHeight / 2
*Size\BitCnt = 1
DeleteObject_(IconInf\hbmMask)
Else
RetVal = - 2
Debug "ERROR!! GetObject failed (Icon_GetInfo)"
EndIf
EndIf
Else
RetVal = - 1
Debug "ERROR! GetIconInfo failed (Icon_GetInfo)"
EndIf
Debug "Width >" + Str(*Size\Width) + "< Height >" + Str(*Size\Height) + "< BPP >" + Str(*Size\BitCnt) + "<"
ProcedureReturn RetVal
EndProcedure
;https://www.purebasic.fr/english/viewtopic.php?t=23387
;SaveIcon.
;By Stephen Rodriguez 2006 (Updated 2010).
;Purebasic 4.5
;This small 'include' file allows for the saving of a single icon/cursor in a .ico/.cur file.
;Extending to include multiple icons/cursors in one file would be straight forward.
;SYNTAX: SaveIcon(hIcon, filename$)
; where 'hIcon' is a handle of an icon/cursor either loaded from a resource file or with LoadImage_() etc.
;NOTES.
; i) This library can only be used with icons/cursors which are already stored in memory
; (either loaded from disc, or created with CreateIconIndirect_() etc.) and
; saves the icon/cursor in the same format (depth etc.) as stored internally by Windows.
; However, this code can quite 'easily' be adapted so that icons/cursors can be created from
; scratch using native Purebasic commands (where images are stored in any format)
; and then, using the code adapted from this library, saved in .ico/.cur format. It's
; just a question of messing with colour tables etc.
; ii) If using this library to save an icon/cursor loaded With LoadImage_(), then it may appear that
; the new icon/cursor is of a different size. This will be because the original .ico/.cur file has multiple
; icons in it of different sizes. Windows explorer may report one size whilst you loaded another etc.
;TODO (maybe!)
; -Extend the code to save multiple icons/cursors in the same .ico file.
; -Extend to cursor .cur files (DONE!)
;**************************************************************************************************
;Result = non-zero if no error.
;Save icon to ico
Procedure.i Icon_SaveToICO(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
;Save icon to png, jpg, bmp, ico, cur
Procedure Icon_SaveToFile(hIcon.i, DestFile.s, plugin)
; http://blogs.msdn.com/b/oldnewthing/archive/2010/10/21/10078690.aspx
; another approach to combine image and mask:
; http://forums.purebasic.com/german/viewtopic.php?p=85298&sid=5a3cfda0f787dc2caec0e8834da98b0a#p85298
Protected TmpImage.i
Protected TmpMask.i
Protected IcoInfo.Icon_Dimension
Protected BmpHdl.i
Protected ImageDC.i
Protected MaskDC.i
Protected PosX.i, PosY.i
Protected ModeARGB.b = #False
Protected RetVal = 1
Protected FreeTmpImage.b = #False
Protected FreeTmpMask.b = #False
Protected plugins.i
If Not Icon_GetInfo(hIcon, @IcoInfo) Or hIcon <= 0
Debug "ERROR!! Icon_GetInfo failed!"
RetVal = - 1
ProcedureReturn RetVal
EndIf
Select plugin
Case 0
If LCase(GetExtensionPart(DestFile)) <> "png"
DestFile + ".png"
EndIf
Case 1
If LCase(GetExtensionPart(DestFile)) <> "jpg" Or LCase(GetExtensionPart(DestFile)) <> "jpeg"
DestFile + ".jpg"
EndIf
Case 2
If LCase(GetExtensionPart(DestFile)) <> "bmp"
DestFile + ".bmp"
EndIf
Case 3
If LCase(GetExtensionPart(DestFile)) <> "ico"
DestFile + ".ico"
EndIf
Case 4
If LCase(GetExtensionPart(DestFile)) <> "cur"
DestFile + ".cur"
EndIf
EndSelect
If RetVal
TmpImage = CreateImage(#PB_Any, IcoInfo\Width, IcoInfo\Height, 32)
If TmpImage
FreeTmpImage = #True
Else
Debug "ERROR!! CreateImage (TmpImage) failed!"
RetVal = - 2
EndIf
EndIf
If RetVal
ImageDC = StartDrawing(ImageOutput(TmpImage))
If Not ImageDC
Debug "ERROR!! StartDrawing failed!"
RetVal = - 3
EndIf
EndIf
If RetVal
If DrawIconEx_(ImageDC, 0, 0, hIcon, 0, 0, 0, 0, #DI_IMAGE);#DI_MASK)
;Check if Icon uses 0RGB or ARGB
DrawingMode(#PB_2DDrawing_AlphaChannel)
For PosY = 0 To IcoInfo\Height - 1
For PosX = 0 To IcoInfo\Width - 1
If (Alpha(Point(PosX, PosY)) > 0) ; ARGB detected
ModeARGB = #True
Break 2
EndIf
Next
Next
StopDrawing()
Else
Debug "ERROR!! DrawIconEx failed!"
RetVal = - 4
EndIf
EndIf
If RetVal
If ModeARGB
Debug "ARGB used"
Else
Debug "0RGB used"
If StartDrawing(ImageOutput(TmpImage)) ;set alpha channel to "opaque"
DrawingMode(#PB_2DDrawing_AlphaChannel)
For PosY = 0 To IcoInfo\Height - 1
For PosX = 0 To IcoInfo\Width - 1
Plot(PosX, PosY, RGBA(0, 0, 0, 255))
Next
Next
StopDrawing()
Else
Debug "ERROR!! StartDrawing (TmpImage) failed!"
RetVal = - 5
EndIf
If RetVal
TmpMask = CreateImage(#PB_Any, IcoInfo\Width, IcoInfo\Height, 24)
If Not TmpMask
Debug "ERROR!! CreateImage (TmpMask) failed!"
RetVal = - 6
EndIf
EndIf
If RetVal
MaskDC = StartDrawing(ImageOutput(TmpMask))
If MaskDC
FreeTmpMask = #True
Else
Debug "ERROR!! StartDrawing (TmpMask) failed!"
RetVal = - 7
EndIf
EndIf
If RetVal
If Not DrawIconEx_(MaskDC, 0, 0, hIcon, 0, 0, 0, 0, #DI_MASK)
Debug "ERROR!! DrawIconEx failed (MaskDC)"
RetVal = - 8
EndIf
EndIf
If RetVal
For PosY = 0 To IcoInfo\Height - 1
For PosX = 0 To IcoInfo\Width - 1
If (Point(PosX, PosY) = $FFFFFF) ; white Pixel - should be fully transparent in Image
StopDrawing()
If StartDrawing(ImageOutput(TmpImage))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Plot(PosX, PosY, RGBA(0, 0, 0, 0))
StopDrawing()
Else
Debug "ERROR!! StartDrawing (TmpImage) failed!"
RetVal = - 9
Break 2
EndIf
If Not StartDrawing(ImageOutput(TmpMask))
Debug "ERROR!! StartDrawing (TmpMask) failed!"
RetVal = - 10
Break 2
EndIf
EndIf
Next
Next
If RetVal
StopDrawing()
EndIf
EndIf
EndIf
EndIf
If FreeTmpMask
FreeImage(TmpMask)
EndIf
If RetVal
plugins = #PB_ImagePlugin_PNG
Select plugin
Case - 1
Debug "ERROR!! SaveImage (" + DestFile + ") failed!"
ProcedureReturn
Case 0;png
plugins = #PB_ImagePlugin_PNG
If Not SaveImage(TmpImage, DestFile, #PB_ImagePlugin_PNG, #Null, 32)
Debug "ERROR!! SaveImage (" + DestFile + ") failed!"
RetVal = - 11
EndIf
Case 1;jpg
plugins = #PB_ImagePlugin_JPEG
If Not SaveImage(TmpImage, DestFile, #PB_ImagePlugin_JPEG, #Null, 32)
Debug "ERROR!! SaveImage (" + DestFile + ") failed!"
RetVal = - 11
EndIf
Case 2;bmp
plugins = #PB_ImagePlugin_BMP
If Not SaveImage(TmpImage, DestFile, #PB_ImagePlugin_BMP, #Null, 32)
Debug "ERROR!! SaveImage (" + DestFile + ") failed!"
RetVal = - 11
EndIf
Case 3, 4;ico & cur
If Not Icon_SaveToICO(hIcon, DestFile)
Debug "ERROR!! SaveImage (" + DestFile + ") failed!"
RetVal = - 11
EndIf
EndSelect
EndIf
If FreeTmpImage
FreeImage(TmpImage)
EndIf
ProcedureReturn RetVal
EndProcedure
;-
;- ##### CODE ################
;- Constant
#LVM_ENABLEGROUPVIEW = #LVM_FIRST + 157
#LVM_MOVEITEMTOGROUP = #LVM_FIRST + 154
#LVM_INSERTGROUP = #LVM_FIRST + 145
#LVIF_GROUPID = $0100
#LVGA_HEADER_LEFT = $1
#LVGA_HEADER_CENTER = $2
#LVGA_HEADER_RIGHT = $4
#LVGS_NORMAL = $0
#LVGS_COLLAPSED = $1
#LVGS_HIDDEN = $2
#LVGF_HEADER = $1
#LVGF_FOOTER = $2
#LVGF_STATE = $4
#LVGF_ALIGN = $8
#LVGF_GROUPID = $10
;- Structure
Structure LVGROUP1 Align #PB_Structure_AlignC
cbSize.l
mask.l
*pszHeader
cchHeader.l
*pszFooter
cchFooter.l
iGroupId.l
stateMask.l
state.l
uAlign.l
EndStructure
Structure LVITEM1 Align #PB_Structure_AlignC
mask.l
iItem.l
iSubItem.l
state.l
stateMask.l
*pszText
cchTextMax.l
iImage.l
lParam.i
iIndent.l
iGroupId.l
cColumns.l
puColunns.l
EndStructure
;- Procedure
Procedure ListIcon_EnableGroupView(gadget.l, state.l)
SendMessage_ (GadgetID(gadget), #LVM_ENABLEGROUPVIEW, state, 0)
EndProcedure
Procedure ListIcon_CreateImageList(cx, cy, flags = #ILC_COLOR32, cInitial = 0, cGrow = 1)
ProcedureReturn ImageList_Create_(cx, cy, flags, cInitial, cGrow)
EndProcedure
Procedure ListIcon_AddImage(himl, hbmImage, hbmMask = 0)
ProcedureReturn ImageList_Add_(himl, hbmImage, hbmMask)
EndProcedure
Procedure ListIcon_SetImageList(gadget, himl, iImageList = #LVSIL_SMALL)
ProcedureReturn SendMessage_(GadgetID(gadget), #LVM_SETIMAGELIST, iImageList, himl)
EndProcedure
Procedure ListIcon_SetImage(gadget, item, index)
Protected itm.LVITEM1
With itm
\mask = #LVIF_IMAGE
\iItem = item
\iImage = index
EndWith
ProcedureReturn SendMessage_ (GadgetID(gadget), #LVM_SETITEM, 0, @itm)
EndProcedure
Procedure ListIcon_AddGroup(gadget.l, text.s, groupid.l)
Protected lvg.LVGROUP1\cbSize = SizeOf(LVGROUP1)
lvg\mask = #LVGF_GROUPID | #LVGF_ALIGN | #LVGF_HEADER
lvg\iGroupId = groupid
lvg\uAlign = #LVGA_HEADER_LEFT
lvg\pszHeader = @text
SendMessage_ (GadgetID(gadget), #LVM_INSERTGROUP, - 1, @lvg)
EndProcedure
Procedure ListIcon_AddItem(gadget.l, text.s, groupid.l, image = - 1) ; SubItems support by Maitre_Kanter
Protected CountSubItem.i , Index, Item
Protected itm.LVITEM1\mask
Protected Buff.s
CountSubItem = CountString( text , Chr(10) )
Buff = StringField( text , 1 , Chr(10) )
If image >= 0
itm\mask = #LVIF_TEXT | #LVIF_GROUPID | #LVIF_IMAGE | #LVIF_DI_SETITEM
itm\iImage = image
Else
itm.LVITEM1\mask = #LVIF_TEXT | #LVIF_GROUPID | #LVIF_DI_SETITEM
EndIf
Item = SendMessage_(GadgetID(gadget), #LVM_GETITEMCOUNT, 0, 0)
itm\pszText = @Buff
itm\iGroupId = groupid
itm\iItem = Item
SendMessage_ (GadgetID(gadget), #LVM_INSERTITEM, 0, @itm)
For Index = 1 To CountSubItem
Define subitm.LVITEM1\mask = #LVIF_TEXT | #LVIF_GROUPID | #LVIF_DI_SETITEM
Buff = StringField( text , Index + 1 , Chr(10) )
subitm\mask = #LVIF_TEXT
subitm\pszText = @Buff
subitm\iGroupId = groupid
subitm\iItem = Item
subitm\iSubItem = Index
SendMessage_ (GadgetID(gadget), #LVM_SETITEM, 0, @subitm)
Next
EndProcedure
Procedure TreeView_ExpandAll()
Protected hwndTV = GadgetID(#tree)
Protected hRoot = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_ROOT, 0)
Protected hItem = hRoot
Repeat
SendMessage_(hwndTV, #TVM_EXPAND, #TVE_EXPAND, hItem)
hItem = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_NEXTVISIBLE , hItem)
Until hItem = #Null
SendMessage_(hwndTV, #TVM_ENSUREVISIBLE, 0, hRoot)
EndProcedure
Procedure TreeView_CollapseAll()
Protected hwndTV = GadgetID(#tree)
Protected hRoot = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_ROOT, 0)
Protected hItem = hRoot
Repeat
SendMessage_(hwndTV, #TVM_EXPAND, #TVE_COLLAPSE, hItem)
hItem = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_NEXTVISIBLE , hItem)
Until hItem = #Null
SendMessage_(hwndTV, #TVM_ENSUREVISIBLE, 0, hRoot)
EndProcedure
;Gadgets initialization
Procedure Init()
;Combo file
;Windows XP
AddGadgetItem(#combobox_files, - 1, "C:\Windows\System32\shell32.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\compstui.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\comres.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\dmdskres.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\dsuiext.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\Explorer.exe")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\System32\filemgmt.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\ieframe.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\mmcndmgr.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\System32\moricons.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\mstscax.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\mstsc.exe")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\pifmgr.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\setupapi.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\System32\Stobject.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\wiashext.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\wmploc.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\wpdshext.dll")
;Windows 7+
AddGadgetItem(#combobox_files, - 1, "")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\accessibilitycpl.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\ddores.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\System32\imageres.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\System32\imagesp1.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\netcenter.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windowssystem32netshell.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\networkexplorer.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\pnidui.dll")
AddGadgetItem(#combobox_files, - 1, "C:\Windows\system32\sensorscpl.dll")
SetGadgetState(#combobox_files, 6)
;Splitters
SetGadgetState(#splitter, 230)
SetGadgetState(#splitter_tree, GadgetHeight(#splitter_tree) * 2 / 3)
;Combobox_saveW, H
AddGadgetItem(#combobox_saveW, - 1, "")
AddGadgetItem(#combobox_saveW, - 1, "16")
AddGadgetItem(#combobox_saveW, - 1, "24")
AddGadgetItem(#combobox_saveW, - 1, "32")
AddGadgetItem(#combobox_saveW, - 1, "64")
AddGadgetItem(#combobox_saveW, - 1, "128")
AddGadgetItem(#combobox_saveW, - 1, "256")
AddGadgetItem(#combobox_saveW, - 1, "512")
AddGadgetItem(#combobox_saveW, - 1, "Other")
AddGadgetItem(#combobox_saveH, - 1, "")
AddGadgetItem(#combobox_saveH, - 1, "16")
AddGadgetItem(#combobox_saveH, - 1, "24")
AddGadgetItem(#combobox_saveH, - 1, "32")
AddGadgetItem(#combobox_saveH, - 1, "64")
AddGadgetItem(#combobox_saveH, - 1, "128")
AddGadgetItem(#combobox_saveH, - 1, "256")
AddGadgetItem(#combobox_saveH, - 1, "512")
AddGadgetItem(#combobox_saveH, - 1, "Other")
SetGadgetState(#combobox_saveW, 6)
SetGadgetState(#combobox_saveH, 6)
; ;#Combobox_saveformat
; AddGadgetItem(#combobox_saveformat, - 1, "png")
; AddGadgetItem(#combobox_saveformat, - 1, "jpg")
; AddGadgetItem(#combobox_saveformat, - 1, "bmp")
; AddGadgetItem(#combobox_saveformat, - 1, "ico")
; AddGadgetItem(#combobox_saveformat, - 1, "cur")
; SetGadgetState(#combobox_saveformat, 0)
;Image encoder/decoder
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
;Text_save 'X' vertically
SetWindowLongPtr_(GadgetID(#text_X), #GWL_STYLE, GetWindowLongPtr_(GadgetID(2), #GWL_STYLE) & ~#SS_CENTER | #SS_CENTERIMAGE)
SetGadgetText(#text_X, "X")
;Tree Popup menu
If CreatePopupMenu(0)
MenuItem(1, "Collapse All")
MenuItem(2, "Expand All")
EndIf
BindMenuEvent(0, 1, @TreeView_CollapseAll())
BindMenuEvent(0, 2, @TreeView_ExpandAll())
;Listicon
SetWindowLongPtr_(GadgetID(#listicon), #GWL_STYLE, GetWindowLongPtr_(GadgetID(#listicon), #GWL_STYLE) | #WS_CLIPCHILDREN)
SetGadgetAttribute(#listicon, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
SendMessage_(GadgetID(#listicon), #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, SendMessage_(GadgetID(#listicon), #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0) | #LVS_EX_TRACKSELECT)
SendMessage_(GadgetID(#listicon), #LVM_SETHOVERTIME, 0, 10)
;Enable listicon Group view
ListIcon_EnableGroupView(#ListIcon, 1)
EndProcedure
;Parse icon from file + fills the treegadget + fills the listicongadget and updates the progressbargadget
Procedure ParseIconFile(File.s = "")
Protected IconSizes.Icon_Size
Protected IconCnt.i, Cnt.i, IcCnt.i, ILwnd
Protected ImID16.i, IconHdl.q, Text$, img, item, Width, Height, BitCnt, itemdata
Protected group$, sLen, GroupName$, k = 0, ok, i, z
ClearGadgetItems(#tree)
ClearGadgetItems(#listicon)
SetGadgetState(#image, 0)
ClearList(List_listicon())
SetGadgetState(#progressbar, 0)
SendMessage_(GadgetID(#tree), #WM_SETREDRAW, 0, 0)
SendMessage_(GadgetID(#listicon), #WM_SETREDRAW, 0, 0)
If file = ""
File = GetGadgetText(#combobox_files)
Else
SetGadgetText(#combobox_files, File)
EndIf
ILwnd = ListIcon_CreateImageList(iSize, iSize, #ILC_COLOR32 | #ILC_MASK, 0, 300)
SendMessage_(GadgetID(#listicon), #LVM_SETIMAGELIST, #LVSIL_NORMAL, ILwnd)
IconCnt = Icon_GetCnt(File)
SetGadgetAttribute(#progressbar, #PB_ProgressBar_Maximum, IconCnt)
For Cnt = 1 To IconCnt
ImID16 = Icon_GetHdl(File, 16, Cnt)
AddGadgetItem(#tree, - 1, "IconNr. " + Str(Cnt), ImID16 , 0)
SetGadgetItemData(#tree, CountGadgetItems(#tree) - 1, Cnt)
Icon_GetSizes(File, @IconSizes, Cnt)
ListIcon_AddGroup(#ListIcon, Str(Cnt), Cnt)
For IcCnt = 0 To ArraySize(IconSizes\Icon_Size())
Width = IconSizes\Icon_Size(IcCnt)\Width
Height = IconSizes\Icon_Size(IcCnt)\Height
BitCnt = IconSizes\Icon_Size(IcCnt)\BitCnt
Text$ = Str(Width) + "x" + Str(Height) + "@" + Str(BitCnt) + "BPP"
If ImID16
AddGadgetItem(#tree, - 1, Text$, ImID16, 1)
SetGadgetItemData(#tree, CountGadgetItems(#tree) - 1, Cnt)
EndIf
AddElement(List_listicon())
List_listicon()\id = Cnt
List_listicon()\w = Width
List_listicon()\h = Height
List_listicon()\bpp = BitCnt
File = GetGadgetText(#combobox_files)
IconHdl = Icon_GetRealHdl(File, Width, Cnt, Height, BitCnt)
img = CreateImage(#PB_Any, iSize, iSize)
If img And StartDrawing(ImageOutput(img))
Box(0, 0, iSize, iSize, $B5BEB2)
If IconHdl > 0
DrawImage(IconHdl, iSize / 2 - Width / 2, iSize / 2 - Height / 2)
EndIf
Icon_DestroyHdl(IconHdl)
StopDrawing()
ListIcon_AddImage(ILwnd, ImageID(img))
k + 1
EndIf
ListIcon_AddItem(#ListIcon, Text$, Cnt)
SetGadgetState(#progressbar, Cnt)
Next
Next
For i = 0 To k
ListIcon_SetImage(#ListIcon, i, i)
Next
SendMessage_(GadgetID(#tree), #WM_SETREDRAW, 1, 0)
SendMessage_(GadgetID(#listicon), #WM_SETREDRAW, 1, 0)
EndProcedure
;Change file with an OpenFileRequester
Procedure SelectFile()
Protected File.s
File = OpenFileRequester("Please select file", "", "FileWithIcon|*.ico;*.cur;*.exe;*.dll;*.bmp", 1)
If File
ParseIconFile(File)
EndIf
EndProcedure
;Displays a zoomed icon when you click on a level 0 tree item, or if you hover an icon in the listicon
Procedure LoadIcon(Gadget = #tree)
Protected IconNr.i
Protected Width.i
Protected Height.i
Protected BitCnt.i
Protected Text.s
Protected IconHdl.i
Protected OldIconHdl.i
Protected File.s
Protected Nr.i
File = GetGadgetText(#combobox_files)
Select Gadget
Case #Tree
Text = GetGadgetText(#tree)
Nr = GetGadgetState(#tree)
IconNr = GetGadgetItemData(#tree, Nr)
If IconNr
Select (GetGadgetItemAttribute(#tree, Nr, #PB_Tree_SubLevel))
Case 0
Width = Val(GetGadgetText(#combobox_saveW))
Height = Val(GetGadgetText(#combobox_saveH))
IconHdl = Icon_GetHdl(File, Width, IconNr, Height)
Case 1
Width = Val(StringField(Text, 1, "x"))
Text = StringField(Text, 2, "x")
Height = Val(StringField(Text, 1, "@"))
Text = StringField(Text, 2, "@")
BitCnt = Val(StringField(Text, 1, "BPP"))
IconHdl = Icon_GetRealHdl(File, Width, IconNr, Height, BitCnt)
EndSelect
EndIf
Case #listicon
Width = List_listicon()\w
Height = List_listicon()\h
BitCnt = List_listicon()\bpp
IconNr = List_listicon()\id
IconHdl = Icon_GetRealHdl(File, Width, IconNr, Height, BitCnt)
Default
ProcedureReturn
EndSelect
If IconHdl
If IsGadget(#Image)
OldIconHdl = GetGadgetState(#Image)
If (OldIconHdl)
SetGadgetState(#Image, 0)
Icon_DestroyHdl(OldIconHdl)
EndIf
SetGadgetState(#Image, IconHdl)
EndIf
EndIf
EndProcedure
;Save on a file the icon cliked on the tree or hovered on the listicon
Procedure SaveIcon()
Protected File.s, Filter$, Res.i
If IsGadget(#Image)
Filter$ = "PNG (*.png)|*.png|JPG (*.jpg)|*.jpg|BMP (*.bmp)|*.bmp|ICO (*.ico)|*.ico|CUR (*.cur)|*.cur"
File = SaveFileRequester("Define destination file", "", Filter$, 0)
If File
Res = Icon_SaveToFile(GetGadgetState(#Image), File, SelectedFilePattern())
If Res < 1
;MessageRequester("ERROR", "Icon_SaveToFile failed!")
MessageRequester("Save icon to file", "Can't Save icon to file.", #PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
EndIf
Else
MessageRequester("Information", "Nothing to save!")
EndIf
EndProcedure
;- Procedure runtime (from the Dialog window)
Runtime Procedure Onchange_combobox_files()
ParseIconFile(GetGadgetText(#combobox_files))
TreeView_ExpandAll()
EndProcedure
Runtime Procedure Onclick_button_openfile()
SelectFile()
TreeView_ExpandAll()
EndProcedure
Runtime Procedure Onclick_tree()
LoadIcon()
EndProcedure
Runtime Procedure OnRclick_tree()
DisplayPopupMenu(0, WindowID(#win))
EndProcedure
Runtime Procedure Onclick_button_saveimage()
SaveIcon()
EndProcedure
Runtime Procedure Onclick_listicon()
;ToDo
EndProcedure
Runtime Procedure Onchange_listicon()
Protected n = GetGadgetState(#listicon)
If n >= 0
SelectElement(List_listicon(), n)
LoadIcon(#listicon)
EndIf
EndProcedure
Runtime Procedure Onchange_combobox_saveW()
Onclick_tree()
EndProcedure
Runtime Procedure Onchange_combobox_saveH()
Onclick_tree()
EndProcedure
;- Window Dialog
Define i, R , ok
Define a$ = GetXMLString()
If ParseXML(0, a$) And XMLStatus(0) = #PB_XML_Success
For i = 1 To #DD_WindowCount
CreateDialog(i)
CompilerIf #DD_UseExtraStuff
R = DEX::InitDialog(i, 0, DD_WindowNames(i), 1)
CompilerElse
R = OpenXMLDialog(i, 0, DD_WindowNames(i))
CompilerEndIf
If R
HideWindow(DialogWindow(i), 0)
ok = #True
;- Go
Init()
ParseIconFile()
TreeView_ExpandAll()
Else
Debug DialogError(i)
EndIf
Next i
CompilerIf Defined(PB_OS_Web, #PB_Constant) = 0 Or #PB_Compiler_OS <> #PB_OS_Web
If ok
;- Loop
While WaitWindowEvent() <> #PB_Event_CloseWindow : Wend
;Repeat
;Select WaitWindowEvent()
;Case #PB_Event_CloseWindow
;Break
;Case #WM_RBUTTONDOWN
;If EventGadget() = #...
;DisplayPopupMenu(0, WindowID(#mainwin))
; EndIf
;EndSelect
;ForEver
EndIf
CompilerEndIf
Else
Debug XMLStatus(0)
Debug XMLError(0)
EndIf
CompilerIf #DD_UseExtraStuff
DEX::DeInit()
CompilerEndIf
;-
;- END
Code : Tout sélectionner
;
;- TOP
;
; __________________________
;|
;| Dialog
;|
;| Date:
;|
;| Author: Dialog MESA
;|
;| PB version: 6.02
;|
;| OS: All
;|
;| CPU: All
;|
;| Note:
;|
;|
;|
;|___________________________
;- Constante
#DD_WindowCount = 1
#DD_UseExtraStuff = 0
CompilerIf #DD_UseExtraStuff
XIncludeFile "../../gadget/dialog/DialogDesign0r/DD_AddStuff.pbi"
CompilerEndIf
Runtime Enumeration Windows
#Win
EndEnumeration
Dim DD_WindowNames.s(#DD_WindowCount)
DD_WindowNames(1) = "window"
Runtime Enumeration Gadgets
#splitter
#container_tree_image
#combobox_files
#button_openfile
#splitter_tree
#tree
#scrollarea
#image
#frame_zoom
#combobox_saveW
#text_X
#combobox_saveH
#frame_save
#button_saveimage
#container_listicon
#listicon
#progressbar
EndEnumeration
;- Declare
Declare Onchange_combobox_files()
Declare Onclick_button_openfile()
Declare OnRclick_tree()
Declare Onclick_tree()
Declare Onchange_combobox_saveW()
Declare Onchange_combobox_saveH()
Declare Onclick_button_saveimage()
Declare Onchange_listicon()
Declare Onclick_listicon()
;- XML
Procedure.s GetXMLString()
Protected XML$
XML$ + "<?xml version='1.0' encoding='UTF-16'?>"
XML$ + ""
XML$ + "<dialogs><!--Created by Dialog Design0R V1.85 => get it from: https://hex0rs.coderbu.de/en/sdm_downloads/dialogdesign0r/-->"
XML$ + " <window flags='#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered' width='900' height='700' margin='vertical:3,horizontal:0' name='window' xpos='0' ypos='0' id='#Win'>"
XML$ + " <vbox spacing='3'>"
XML$ + " <hbox spacing='0'>"
XML$ + " <splitter flags='#PB_Splitter_Vertical | #PB_Splitter_Separator' id='#splitter'>"
XML$ + " <container margin='vertical:0,horizontal:0' id='#container_tree_image'>"
XML$ + " <vbox expand='item:2'>"
XML$ + " <hbox expand='item:1' spacing='0'>"
XML$ + " <combobox text='shell32.dll' flags='#PB_ComboBox_Editable' id='#combobox_files' onchange='Onchange_combobox_files()'/>"
XML$ + " <button text='...' id='#button_openfile' onevent='Onclick_button_openfile()'/>"
XML$ + " </hbox>"
XML$ + " <splitter flags='#PB_Splitter_Separator' id='#splitter_tree'>"
XML$ + " <tree width='300' height='300' id='#tree' onleftclick='Onclick_tree()' onrightclick='OnRclick_tree()'/>"
XML$ + " <scrollarea id='#scrollarea'>"
XML$ + " <image width='300' height='300' id='#image'/> "
XML$ + " </scrollarea> "
XML$ + " </splitter>"
XML$ + " <hbox expand='item:6'>"
XML$ + " <frame text='Zoom' id='#frame_zoom'>"
XML$ + " <hbox>"
XML$ + " <combobox flags='#PB_ComboBox_Editable' text='256' width='60' id='#combobox_saveW' onchange='Onchange_combobox_saveW()'/>"
XML$ + " <text text='X' flags='#PB_Text_Center' id='#text_X'/>"
XML$ + " <combobox text='256' width='60' flags='#PB_ComboBox_Editable' id='#combobox_saveH' onchange='Onchange_combobox_saveH()'/> "
XML$ + " </hbox> "
XML$ + " </frame>"
XML$ + " <frame text='Save' id='#frame_save'>"
XML$ + " <hbox>"
XML$ + " <button text='Save' id='#button_saveimage' onevent='Onclick_button_saveimage()'/> "
XML$ + " </hbox> "
XML$ + " </frame> "
XML$ + " </hbox> "
XML$ + " </vbox> "
XML$ + " </container>"
XML$ + " <container margin='vertical:0,horizontal:0' id='#container_listicon'>"
XML$ + " <vbox expand='item:1'>"
XML$ + " <listicon id='#listicon' onleftclick='Onclick_listicon()' onchange='Onchange_listicon()'/>"
XML$ + " <progressbar height='20' min='0' max='100' value='0' id='#progressbar'/>"
XML$ + " </vbox> "
XML$ + " </container> "
XML$ + " </splitter> "
XML$ + " </hbox> "
XML$ + " </vbox> "
XML$ + " </window>"
XML$ + "</dialogs><!--DDesign0R Definition: PureBasic|1|1|1|_04|Mesa|1-->"
ProcedureReturn XML$
EndProcedure
;- Test it
CompilerIf #PB_Compiler_IsMainFile
;- Procedure runtime
Runtime Procedure Onchange_combobox_files()
EndProcedure
Runtime Procedure Onclick_button_openfile()
EndProcedure
Runtime Procedure OnRclick_tree()
EndProcedure
Runtime Procedure Onclick_tree()
EndProcedure
Runtime Procedure Onchange_combobox_saveW()
EndProcedure
Runtime Procedure Onchange_combobox_saveH()
EndProcedure
Runtime Procedure Onclick_button_saveimage()
EndProcedure
Runtime Procedure Onchange_listicon()
EndProcedure
Runtime Procedure Onclick_listicon()
EndProcedure
;- Entry point
a$ = GetXMLString()
If ParseXML(0, a$) And XMLStatus(0) = #PB_XML_Success
For i = 1 To #DD_WindowCount
CreateDialog(i)
CompilerIf #DD_UseExtraStuff
R = DEX::InitDialog(i, 0, DD_WindowNames(i), 1)
CompilerElse
R = OpenXMLDialog(i, 0, DD_WindowNames(i))
CompilerEndIf
If R
HideWindow(DialogWindow(i), 0)
ok = #True
;Init()
Else
Debug DialogError(i)
EndIf
Next i
CompilerIf Defined(PB_OS_Web, #PB_Constant) = 0 Or #PB_Compiler_OS <> #PB_OS_Web
If ok
While WaitWindowEvent() <> #PB_Event_CloseWindow : Wend
;Repeat
;Select WaitWindowEvent()
;Case #PB_Event_CloseWindow
;Break
;Case #WM_RBUTTONDOWN
;If EventGadget() = #...
;DisplayPopupMenu(0, WindowID(#mainwin))
; EndIf
;EndSelect
;ForEver
EndIf
CompilerEndIf
Else
Debug XMLStatus(0)
Debug XMLError(0)
EndIf
CompilerIf #DD_UseExtraStuff
DEX::DeInit()
CompilerEndIf
CompilerEndIf
;- End
