YAIG: Yet Another Icon Grabber
Posted: Thu Oct 24, 2024 3:07 pm
An icon and cursor extractor.
Windows only, x64, x86 from Windows Xp to Windows 10, and probably 11 (not tested).
YAIG.pb
ExtractIcons.xml.dd.pbi
MESA.
Windows only, x64, x86 from Windows Xp to Windows 10, and probably 11 (not tested).
YAIG.pb
Code: Select all
;- 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
Procedure Icon_SaveToPNG(hIcon.i, DestFile.s)
; 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
If LCase(GetExtensionPart(DestFile)) <> "png"
DestFile + ".png"
EndIf
If Not Icon_GetInfo(hIcon, @IcoInfo)
Debug "ERROR!! Icon_GetInfo failed!"
RetVal = - 1
EndIf
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
If Not SaveImage(TmpImage, DestFile, #PB_ImagePlugin_PNG, #Null, 32)
Debug "ERROR!! SaveImage (" + DestFile + ") failed!"
RetVal = - 11
EndIf
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")
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
If IsGadget(#Image)
File = SaveFileRequester("Define destination file", "", "PNG-Image (*.png)|*.png", 0)
If File
If Not Icon_SaveToPNG(GetGadgetState(#Image), File)
MessageRequester("ERROR", "Icon_SaveToPNG failed!")
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
;- 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: Select all
;
;- 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
#combobox_saveformat
#container_listicon
#listicon
#progressbar
EndEnumeration
;- Declare
Declare Onchange_combobox_files()
Declare Onclick_button_openfile()
Declare OnRclick_tree()
Declare Onclick_tree()
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'/>"
XML$ + " <text text='X' flags='#PB_Text_Center' id='#text_X'/>"
XML$ + " <combobox text='256' width='60' flags='#PB_ComboBox_Editable' id='#combobox_saveH'/> "
XML$ + " </hbox>"
XML$ + " </frame>"
XML$ + " <frame text='Save' id='#frame_save'>"
XML$ + " <hbox>"
XML$ + " <button text='...' id='#button_saveimage' onevent='Onclick_button_saveimage()'/>"
XML$ + " <combobox width='60' text='png' id='#combobox_saveformat'/>"
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|_5_|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 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