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
Nach einigen Recherchen habe ich inzwischen den WinAPI-Befehl "SHGetFileInfo_()" gefunden, der auch Icons von Dateien ermittelt, die selber die Icons nicht beinhalten (z. B. *.txt, *.pb usw.).
Was mich an diesem Befehl noch gestört hat, ist, dass nur das kleine Icon oder das große Icon ermittelt werden konnte - also keine Zwischengrößen. Dieses Manko konnte ich mit dem zusätzlichen Befehl "SHGetImageList" beseitigen.
So sieht der Code aktuell aus und würde ich so in Kürze in den FileInfo-Modul-Code integrieren:
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
Ich habe hier nur ein WindowsXP zum Testen.