Jump to content
Tuts 4 You

PureBasic Adventures - ExtractIconEx Revisited


Teddy Rogers

Recommended Posts

Teddy Rogers

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

Link to comment

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 account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...