Aktuelle Zeit: 02.04.2020 11:26

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 14 Beiträge ]  Gehe zu Seite Vorherige  1, 2
Autor Nachricht
 Betreff des Beitrags: Re: Modul "FileInfo"
BeitragVerfasst: 22.07.2018 18:32 
Offline
Benutzeravatar

Registriert: 11.08.2005 19:08
Danke, ts-soft, mit deinem vorgeschlagenem Befehl funktioniert es sehr einfach:
Code:
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:
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
PureBasic-CodeArchiv-Rebirth: Git-Repository / Download – Jede Hilfe ist willkommen!
Manjaro Xfce x64 (Hauptsystem) :: WindowsXP/Xubuntu x86 (VirtualBox) :: PureBasic (Linux: x86/x64, Windows: x86) :: jeweils neueste Version


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul "FileInfo"
BeitragVerfasst: 22.07.2018 19:20 
Offline
Admin
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
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.

_________________
BildBildBildBild BildBild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul "FileInfo"
BeitragVerfasst: 23.07.2018 09:59 
Offline

Registriert: 21.01.2008 19:11
Funktioniert ebenfalls unter Win7 x64, PB 5.70LTS x64.

_________________
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul "FileInfo"
BeitragVerfasst: 25.07.2018 19:23 
Offline
Benutzeravatar

Registriert: 11.08.2005 19:08
Danke fürs Testen :allright:

Ein Fehler habe ich selber noch gefunden:

Neue Version ist nun online.

_________________
Bild
Warum OpenSource eine Lizenz haben sollte
PureBasic-CodeArchiv-Rebirth: Git-Repository / Download – Jede Hilfe ist willkommen!
Manjaro Xfce x64 (Hauptsystem) :: WindowsXP/Xubuntu x86 (VirtualBox) :: PureBasic (Linux: x86/x64, Windows: x86) :: jeweils neueste Version


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 14 Beiträge ]  Gehe zu Seite Vorherige  1, 2

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 4 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye