Teddy Rogers Posted June 1, 2020 Posted June 1, 2020 This is a repost from the "PureBasic Adventures" blog... With the excitement of Windows 10 and a host of bug fixes out of the way I can now concentrate some time on Tuts 4 You which also allows me to post some code on this blog. This blog entry is in regard to a recent query from @LCF-AT on viewing icons contained within DLL's, executables, icon files, etc. I coded a small tool for this a while ago that enabled me to quickly view icons contained primarily within shell32.dll and imageres.dll so that I could take advantage of those icons in other code. Most of the magic is done by Windows API ExtractIconEx function and from there we simply manipulate the icon images to display them in a gadget list window. As you can see from the code below I have taken advantage of mixing both Windows API with PureBasic API's to achieve the results. For those of you who have read my previous blog entries may be astute enough to see the similarities with the code posted in my PureBasic Adventures blog entry. The attached archive contains compiled code for those who would like to see use the end result and do not have PureBasic installed (shame on you!). The archive also contains the .pb code file(s) and some rough bonus code using DrawIconEx API to draw icons directly to a window... UsePNGImageEncoder() ; Declare the procedures... Declare Menu_ExtractIcon() Declare Menu_ExtractIconAll() Declare Menu_About() Declare Menu_Callback(hWnd, uMsg, wParam, lParam) ; Declare some global variables... Global Gadget Global FileName.s Global Title.s = "Quick Icon Viewer v0.1" Global Info.s = "A small program to view and extract icons as .BMP or .PNG."+Chr(13)+Chr(13)+"Code: Teddy Rogers"+Chr(13)+"URL: http://tuts4you.com"+Chr(13)+"E-Mail: teddyrogers@tuts4you.com" ; Create our window and explorer list gadget then let the magic happen... If OpenWindow(0, #Null, #Null, 600, 500, Title.s, #PB_Window_ScreenCentered | #PB_Window_SystemMenu) ExplorerListGadget(0, 1, 2, 598, 297, GetCurrentDirectory(), #PB_Explorer_GridLines | #PB_Explorer_AutoSort | #PB_Explorer_HiddenFiles | #PB_Explorer_FullRowSelect) ; Create the icon gadget windows and set the attributes to display small and large icons... ListIconGadget(1, 1, 300, 299, 176, "", #Null) ListIconGadget(2, 301, 300, 298, 176, "", #Null) ; Customise the list icon display mode... SetGadgetAttribute(1, #PB_ListIcon_DisplayMode, #PB_ListIcon_SmallIcon) SetGadgetAttribute(2, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon) ; Create the status bar and text fields for some stats/counters... If CreateStatusBar(0, WindowID(0)) AddStatusBarField(#PB_Ignore) AddStatusBarField(#PB_Ignore) AddStatusBarField(#PB_Ignore) AddStatusBarField(#PB_Ignore) StatusBarText(0, 0, "Small Icons (16 x 16) :", #PB_StatusBar_Right) StatusBarText(0, 2, "Large Icons (32 x 32) :", #PB_StatusBar_Right) EndIf ; Create the popup menu and bind the menu events... If CreatePopupMenu(MyMenu) MenuItem(1, "Extract") MenuItem(2, "Extract All") MenuBar() MenuItem(3, "About") BindMenuEvent(MyMenu, 1, @Menu_ExtractIcon()) BindMenuEvent(MyMenu, 2, @Menu_ExtractIconAll()) BindMenuEvent(MyMenu, 3, @Menu_About()) ; Create the callback to process the events in the icon gadget lists... SetWindowCallback(@Menu_Callback()) EndIf Repeat MyEvent = WaitWindowEvent() Select MyEvent Case #PB_Event_Gadget Select EventGadget() Case 0 Select EventType() Case #PB_EventType_Change ; Auto size the four explorer list gadget columns... For i = 0 To 4 SendMessage_(GadgetID(0), #LVM_SETCOLUMNWIDTH, i, #LVSCW_AUTOSIZE_USEHEADER) Next i Case #PB_EventType_LeftClick ; Check if the user selected a different file in the explorer gadget list before processing new events... If FileName.s <> GetGadgetText(0) + GetGadgetItemText(0, GetGadgetState(0)) ; Get the directory and file name from ExplorerListGadget... FileName.s = GetGadgetText(0) + GetGadgetItemText(0, GetGadgetState(0)) ; Clear up any previously diaplyed icons... ClearGadgetItems(1) : ClearGadgetItems(2) ; Return the total number of icons in the specified file... IconNum = ExtractIconEx_(PeekS(@FileName), -1, #Null, #Null, #Null) ; Create a simple array for storing the small and large icons... Dim hIcon_Small(IconNum) : Dim hIcon_Large(IconNum) ; Extract the icons in to the array... If IconNum ExtractIconEx_(PeekS(@FileName), #Null, hIcon_Large(), hIcon_Small(), IconNum) EndIf ; Change the window icon. Using SHGetFileInfo retrieves file, folder, directory, and drive icons... If SHGetFileInfo_(PeekS(@FileName), #FILE_ATTRIBUTE_NORMAL, @FileIcons.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON | #SHGFI_USEFILEATTRIBUTES) SetClassLongPtr_(WindowID(0), #GCL_HICON, FileIcons\hIcon) DestroyIcon_(FileIcons\hIcon) EndIf ; Add the icons stored in the array to the gadget list and destroy the icon in the array... For a = 0 To IconNum - 1 If hIcon_Small(a) AddGadgetItem(1, -1, Str(a) + " / $" + Hex(a), hIcon_Small(a)) DestroyIcon_(hIcon_Small(a)) EndIf If hIcon_Large(a) AddGadgetItem(2, -1, Str(a) + " / $" + Hex(a), hIcon_Large(a)) DestroyIcon_(hIcon_Large(a)) EndIf Next a ; When we are finished displaying the icons in the gadget list free both arrays from memory... FreeArray(hIcon_Small()) FreeArray(hIcon_Large()) ; Count the items in each of the icon gadget windows... StatusBarText(0, 1, Str(CountGadgetItems(1)), #PB_StatusBar_Center) StatusBarText(0, 3, Str(CountGadgetItems(2)), #PB_StatusBar_Center) EndIf EndSelect Case 1 Select EventType() Case #PB_EventType_LeftClick ; First check to see if there are any icons in the gadget then change the window icon... If GetGadgetState(1) => 0 If ExtractIconEx_(PeekS(@FileName), GetGadgetState(1), #Null, @iIcon, 1) SetClassLongPtr_(WindowID(0), #GCL_HICON, iIcon) DestroyIcon_(iIcon) EndIf EndIf EndSelect Case 2 Select EventType() Case #PB_EventType_LeftClick ; First check to see if there are any icons in the gadget then change the window icon... If GetGadgetState(2) => 0 If ExtractIconEx_(PeekS(@FileName), GetGadgetState(2), @iIcon, #Null, 1) SetClassLongPtr_(WindowID(0), #GCL_HICON, iIcon) DestroyIcon_(iIcon) EndIf EndIf EndSelect EndSelect EndSelect Until MyEvent = #PB_Event_CloseWindow EndIf Procedure Menu_ExtractIcon() Protected MyImage, x, SaveFilename.s, ImageFormat, Extension.s ; If there are no icons selected create an error message then exit procedure... If GetGadgetState(Gadget) = -1 MessageRequester("Error!", "There is no image to save!", #MB_ICONINFORMATION | #MB_TOPMOST | #MB_SETFOREGROUND) ProcedureReturn EndIf ; Show the save dialogue and ask user to input file name, we can create a default filename based upon current date/time... SaveFilename.s = SaveFileRequester("Saving your image...", FormatDate("%yyyy.%mm.%dd-%hh.%ii.%ss", Date()), "PNG Format|*.png|BMP Format|*.bmp", #Null) ; Store the required extension and format type... Select SelectedFilePattern() Case 0 ; PNG ImageFormat = #PB_ImagePlugin_PNG Extension.s = ".png" Case 1 ; BMP ImageFormat = #PB_ImagePlugin_BMP Extension.s = ".bmp" EndSelect ; If called from small gadget list we want small icons and vice-versa for large, then extract a single icon... If Gadget = 1 ExtractIconEx_(PeekS(@FileName), GetGadgetState(Gadget), #Null, @iIcon, 1) x = 16 Else ExtractIconEx_(PeekS(@FileName), GetGadgetState(Gadget), @iIcon, #Null, 1) x = 32 EndIf ; Create a new image then draw the icon to it... If CreateImage(MyImage, x, x, 32) StartDrawing(ImageOutput(MyImage)) DrawingMode(#PB_2DDrawing_AllChannels) DrawImage(iIcon, 0, 0, x, x) StopDrawing() EndIf ; Destroy the icon in the array to prevent GDI leaks... DestroyIcon_(iIcon) ; If the image is a valid image save it then free the new image from memory when done... If IsImage(MyImage) If SaveImage(MyImage, SaveFilename.s + Extension.s, ImageFormat) FreeImage(MyImage) EndIf EndIf ProcedureReturn EndProcedure Procedure Menu_ExtractIconAll() Protected MyImage, x, a, SaveFilename.s, ImageFormat, Extension.s ; If there are no icons selected create an error message then exit procedure... If GetGadgetState(Gadget) = -1 MessageRequester("Error!", "There are no images to save!", #MB_ICONINFORMATION | #MB_TOPMOST | #MB_SETFOREGROUND) ProcedureReturn EndIf ; Show the save dialogue and ask user to input file name, we can create a default filename based upon current date/time... SaveFilename.s = SaveFileRequester("Saving all your images...", FormatDate("%yyyy.%mm.%dd-%hh.%ii.%ss", Date()), "PNG Format|*.png|BMP Format|*.bmp", #Null) ; Store the required extension and format type... Select SelectedFilePattern() Case 0 ; PNG ImageFormat = #PB_ImagePlugin_PNG Extension.s = ".png" Case 1 ; BMP ImageFormat = #PB_ImagePlugin_BMP Extension.s = ".bmp" EndSelect ; If called from small gadget list we want small icons and vice-versa for large, then extract all icons in to an array... If Gadget = 1 Dim iIcon(CountGadgetItems(1)) ExtractIconEx_(PeekS(@FileName), #Null, #Null, iIcon(), ArraySize(iIcon())) x = 16 Else Dim iIcon(CountGadgetItems(2)) ExtractIconEx_(PeekS(@FileName), #Null, iIcon(), #Null, ArraySize(iIcon())) x = 32 EndIf ; Create a new image then draw the icon to it... For a = 0 To ArraySize(iIcon()) - 1 If CreateImage(MyImage, x, x, 32) StartDrawing(ImageOutput(MyImage)) DrawingMode(#PB_2DDrawing_AllChannels) DrawImage(iIcon(a), 0, 0, x, x) StopDrawing() EndIf ; Destroy the icon in the array to prevent GDI leaks... DestroyIcon_(iIcon(a)) ; If the image is a valid image save it then free the new image from memory when done... If IsImage(MyImage) If SaveImage(MyImage, SaveFilename.s + Str(a) + Extension.s, ImageFormat) FreeImage(MyImage) EndIf EndIf ; Process next icon in the array until all complete then free the array... Next a FreeArray(iIcon()) ProcedureReturn EndProcedure Procedure Menu_About() MessageRequester(Title.s, Info.s, #MB_ICONINFORMATION | #MB_TOPMOST | #MB_SETFOREGROUND) EndProcedure Procedure Menu_Callback(hWnd, uMsg, wParam, lParam) If uMsg = #WM_CONTEXTMENU Select wParam Case GadgetID(1) DisplayPopupMenu(MyMenu, WindowID(0)) Gadget = 1 Case GadgetID(2) DisplayPopupMenu(MyMenu, WindowID(0)) Gadget = 2 EndSelect EndIf ProcedureReturn #PB_ProcessPureBasicEvents EndProcedure The "cycle icons" sample found in the attached archive... Declare CycleIcons(void) If OpenWindow(0, 0, 0, 100, 100, "CycleIcons", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) CreateThread(@CycleIcons(), #Null) Repeat Event = WaitWindowEvent() Until Event = #PB_Event_CloseWindow EndIf Procedure CycleIcons(void) FileName.s = GetCurrentDirectory() + "\test files\imageres.dll" IconNum = ExtractIconEx_(FileName.s, -1, #Null, #Null, #Null) Dim hIcon_Small(IconNum) Dim hIcon_Large(IconNum) ExtractIconEx_(FileName.s, 0, hIcon_Large(), hIcon_Small(), IconNum) hDC = GetDC_(WindowID(0)) For a = 0 To IconNum - 1 ExtFloodFill_(hDC, #Null, #Null, $f123, #FLOODFILLBORDER) SetWindowText_(WindowID(0), "Icon: " + a + "/" + Hex(a)) SetClassLongPtr_(WindowID(0), #GCL_HICON, hIcon_Small(a)) DrawIconEx_(hDC, 25, 30, hIcon_Small(a), #Null, #Null, #Null, #Null, #DI_NORMAL) DrawIconEx_(hDC, 65, 30, hIcon_Large(a), #Null, #Null, #Null, #Null, #DI_NORMAL) DestroyIcon_(hIcon_Small(a)) DestroyIcon_(hIcon_Large(a)) Sleep_(500) Next a DeleteDC_(hDC) EndProcedure Ted. Quick Icon Viewer.zip
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now