PureBoard

Code: Alles auswählen

Define Icon
Define FilePath$

;Define IconSize  = 16
;Define IconSize  = 24
Define IconSize  = 32
;Define IconSize  = 48
;Define IconSize  = 64
;Define IconSize  = 128
;Define IconSize  = 256
;Define IconSize  = 1000

; Für Icon-Größen, die in der Datei nicht existieren, werden vorhandene
; Icons auf die geforderte Icon-Größe angepasst.
; Ob dabei das nächstgrößere Icon oder das nächstkleinere Icon genommen
; wird, ist mir nicht bekannt.

FilePath$ = "C:\Programme\7-Zip\7zFM.exe"

If OpenLibrary(0, FilePath$)
  Icon = LoadImage_(LibraryID(0), @"#1", #IMAGE_ICON, IconSize, IconSize, #LR_DEFAULTCOLOR)
  CloseLibrary(0)
EndIf

If Icon
  
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 500, 500, "Extract Icon", #PB_Window_SystemMenu)
    ImageGadget(0, 10, 10, 100, 100, Icon, #PB_Image_Border)
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf
  
  DestroyIcon_(Icon)
EndIf

Code: Alles auswählen

EnableExplicit

DataSection
  IID_IImageList:
  Data.l $46EB5926
  Data.w $582E, $4017
  Data.b $9F, $DF, $E8, $99, $8D, $AA, $09, $50
EndDataSection

Procedure.i SHGetImageList(iImageList.i, riid.i, *ppvObj)
  
  Protected Library, Result
  
  Library = OpenLibrary(#PB_Any, "shell32.dll")
  If Library
    Result = CallFunction(Library, "SHGetImageList", iImageList.i, riid.i, *ppvObj)
    CloseLibrary(Library)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure

Procedure.i GetIcon(FilePath$, IconSize, StretchIcon=#False)
  
  Protected FileInfo.SHFILEINFO, ImageList.IImageList
  Protected IconHandle, Image, IconSizeType, RealIconWidth, RealIconHeight
  
  Select IconSize
      
    Case 1 To 16
      IconSizeType = #SHIL_SMALL
      ; These images are the Shell standard small icon size of 16x16, but
      ; the size can be customized by the user.
      
      ; 1 pixel icon makes little sense, but it should still be possible.
      ; The procedure should only be aborted if the icon size is 0 pixels
      ; or larger than the maximum.
      
    Case 17 To 32
      IconSizeType = #SHIL_LARGE
      ; The image size is normally 32x32 pixels. However, if the use large
      ; icons option is selected from the Effects section of the Appearance
      ; tab in Display Properties, the image is 48x48 pixels.
      
    Case 33 To 48
      IconSizeType = #SHIL_EXTRALARGE
      ; These images are the Shell standard extra-large icon size. This is
      ; typically 48x48, but the size can be customized by the user.
      
    Case 49 To 8192
      ; Because it is possible to stretch the icons, the maximum image size
      ; supported by the operating systems is also included here.
      If OSVersion() >= #PB_OS_Windows_Vista
        IconSizeType = #SHIL_JUMBO
        ; Windows Vista and later. The image is normally 256x256 pixels.
      Else
        IconSizeType = #SHIL_EXTRALARGE
        ; Because the operating system does not support such large icons,
        ; use the maximum supported icon size type as a fallback.
      EndIf
      
    Default
      ProcedureReturn 0
      
  EndSelect
  
  ; Get the index of the system image list icon
  SHGetFileInfo_(@FilePath$, 0, @FileInfo, SizeOf(FileInfo), #SHGFI_SYSICONINDEX)
  
  ; Get an image list that contains icons of the required size
  If SHGetImageList(IconSizeType, ?IID_IImageList, @ImageList) = #S_OK
    
    ; Get the icon at the specified index position
    ImageList\GetIcon(FileInfo\iIcon, #ILD_TRANSPARENT, @IconHandle)
    If IconHandle
      
      ; Create a PB image and draw the icon into it
      Image = CreateImage(#PB_Any, IconSize, IconSize, 32, #PB_Image_Transparent)
      If Image
        If StartDrawing(ImageOutput(Image))
          If StretchIcon
            ; If there is no icon in the file that corresponds to the
            ; required size, the image is resized to the required size
            ; in this mode.
            DrawImage(IconHandle, 0, 0, IconSize, IconSize)
          Else
            ; If there is no icon in the file that corresponds to the
            ; required size, the image is positioned centered in this mode.
            ImageList\GetIconSize(@RealIconWidth, @RealIconHeight)
            
            If (IconSize < RealIconWidth) Or (IconSize < RealIconHeight)
              ; If the obtained icon is larger than the required size, the
              ; icon will be drawn downsized.
              DrawImage(IconHandle, 0, 0, IconSize, IconSize)
            Else
              ; Draw the icon centered
              DrawImage(IconHandle, IconSize/2-RealIconWidth/2, IconSize/2-RealIconHeight/2)
            EndIf
          EndIf
          StopDrawing()
        EndIf
      EndIf
      
      ; Clean up
      DestroyIcon_(IconHandle)
    EndIf
    
  EndIf
  
  ProcedureReturn Image
  
EndProcedure

Define Image = GetIcon("C:\Programme\7-Zip\7zFM.exe", 48)
;Define Image = GetIcon("C:\Dokumente und Einstellungen\Anonym\Desktop\test.pb", 32)
;Define Image = GetIcon("C:\Programme\PureBasic\PureBasic.exe", 100)

If OpenWindow(0,0,0,500,500,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ImageGadget(0,10,10,100,100,ImageID(Image), #PB_Image_Border)
  
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf