Modul "FileInfo"

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Modul "FileInfo"

Beitrag von Sicro »

Danke, ts-soft, mit deinem vorgeschlagenem Befehl funktioniert es sehr einfach:

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
Allerdings funktioniert das so nur mit EXE- und (vermutlich) DLL-Dateien.

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
Es wäre schön, wenn noch ein paar Leute den Code unter verschiedenen Windows-Versionen und mit verschiedenen Dateien testen würden.
Ich habe hier nur ein WindowsXP zum Testen.
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Modul "FileInfo"

Beitrag von RSBasic »

Sicro hat geschrieben:]Es wäre schön, wenn noch ein paar Leute den Code unter verschiedenen Windows-Versionen und mit verschiedenen Dateien testen würden.
Ich habe hier nur ein WindowsXP zum Testen.
Unter W10 x64 funktioniert.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Lord
Beiträge: 313
Registriert: 21.01.2008 19:11

Re: Modul "FileInfo"

Beitrag von Lord »

Funktioniert ebenfalls unter Win7 x64, PB 5.70LTS x64.
Bild
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Modul "FileInfo"

Beitrag von Sicro »

Danke fürs Testen :allright:

Ein Fehler habe ich selber noch gefunden: Neue Version ist nun online.
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Antworten