PureBasic

Le Soldat Inconnu a écrit :Je viens de faire des essais avec la fonction ExplorerGadget de PB et ça marche nickel pour mon icône, comment,il fait Fred pour choper les icônes associé à un fichier ?
Je suis sur que c'est lui qui l'a programmé car il a fait une gestion avancé au niveau des icônes pour ne pas charger 2 fois le même.
Fred !!! Au secours

je crois que le mien serait qu'il nous fasse la fonction direct dans PB, non ?

Je crois que c'est Freak qui a programmé l'ExplorerGadget (je dis ça car j'avais posté un bug sur l'explorer et Fred a répondu qu'il avait demandé à Freak)

voilà un prog qui affiche propement mon problème, v demandé au english une solution ce soir

Code : Tout sélectionner

Procedure CreateIcon(Transparency.l)
  ; This procedure create an icon
  If CreateFile(0, "test" + Str(Transparency) + ".ico")
    WriteLong(65536)
    WriteWord(1)
    WriteByte(32)
    WriteByte(32)
    WriteLong(65536)
    WriteWord(32)
    WriteLong(4264)
    WriteLong(22)
    WriteLong(40)
    WriteLong(32)
    WriteLong(64)
    WriteWord(1)
    WriteWord(32)
    WriteLong(0)
    WriteLong(4224)
    WriteLong(0)
    WriteLong(0)
    WriteLong(0)
    WriteLong(0)
    
    For n = 1 To 32
      For nn = 1 To 32
        
        WriteByte(0)
        WriteByte(0)
        WriteByte(255)
        WriteByte(Transparency)
        
      Next
    Next
    
    For n = 1 To 32
      WriteLong(0)
    Next
    
    CloseFile(0)
  EndIf
EndProcedure


; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 500, 300, #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget, "Test") = 0 Or CreateGadgetList(WindowID()) = 0
  End
EndIf

Transparency = 128
CreateIcon(Transparency)

IconPath.s = "test" + Str(Transparency) + ".ico"
SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON)
Icone1 = InfosFile\hIcon
ImageGadget(0, 10, 10, 32, 32, Icone1)
TextGadget(#PB_Any, 10, 50, 100, 50, "SHGetFileInfo")

ExtractIconEx_(IconPath, IconIndex, @Icone2, 0, 1)
ImageGadget(1, 110, 10, 32, 32, Icone2)
TextGadget(#PB_Any, 110, 50, 100, 50, "ExtractIconEx" + Chr(10) + "But there only works with *.ico, *.exe or *.dll")

TrackBarGadget(10, 10, 200, 480, 20, 1, 255)
SetGadgetState(10, Transparency)
TextGadget(11, 10, 230, 290, 15, "icon transparency = " + Str(Transparency))

Repeat
  Event = WaitWindowEvent()
  
  If Event = #PB_EventGadget
    Select EventGadgetID()
      Case 10
        DestroyIcon_(Icone1)
        DestroyIcon_(Icone2)
        DeleteFile("test" + Str(Transparency) + ".ico")
        
        Transparency = GetGadgetState(10)
        TextGadget(11, 10, 230, 290, 15, "icon transparency = " + Str(Transparency))
        
        CreateIcon(Transparency)
        IconPath.s = "test" + Str(Transparency) + ".ico"
        
        SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON)
        Icone1 = InfosFile\hIcon
        SetGadgetState(0, Icone1)
        
        ExtractIconEx_(IconPath, IconIndex, @Icone2, 0, 1)
        SetGadgetState(1, Icone2)
        
        InvalidateRect_(WindowID(), 0, 1)
        UpdateWindow_(WindowID())
        
    EndSelect
  EndIf
  
Until Event = #PB_EventCloseWindow

DestroyIcon_(Icone1)
DestroyIcon_(Icone2)
DeleteFile("test" + Str(Transparency) + ".ico")

End

voila un aperçu de mon prob dans le cadre réel :

On voit bien les point noir sur le bord de l'icône sur le premier menu(l'icone est un cerble blanc)
Et sur le 2ème, j'affiche l'icone avec ExtractIconEx donc pas de pb mais ça ne marche pas avec tout les types de fichiers

pfouu, je tiens une solution

il faut passer par les ImageList en dessinant directement l'icône à partir de celle-ci.
voir cet exemple

Code : Tout sélectionner

Procedure CreateIcon(Transparency.l)
  ; This procedure create an icon
  If CreateFile(0, "test" + Str(Transparency) + ".ico")
    WriteLong(65536)
    WriteWord(1)
    WriteByte(32)
    WriteByte(32)
    WriteLong(65536)
    WriteWord(32)
    WriteLong(4264)
    WriteLong(22)
    WriteLong(40)
    WriteLong(32)
    WriteLong(64)
    WriteWord(1)
    WriteWord(32)
    WriteLong(0)
    WriteLong(4224)
    WriteLong(0)
    WriteLong(0)
    WriteLong(0)
    WriteLong(0)
    
    For n = 1 To 32
      For nn = 1 To 32
        
        WriteByte(0)
        WriteByte(0)
        WriteByte(255)
        WriteByte(Transparency)
        
      Next
    Next
    
    For n = 1 To 32
      WriteLong(0)
    Next
    
    CloseFile(0)
  EndIf
EndProcedure



; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 500, 200, #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget, "Test") = 0 Or CreateGadgetList(WindowID()) = 0
  End
EndIf

Transparency = 120
CreateIcon(Transparency)


; on récupère le hangle de l'imagelist
Global hImageListS.l
hImageListS.l = SHGetFileInfo_(0, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)

IconPath.s = "test" + Str(Transparency) + ".ico"
SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
Icone1 = InfosFile\hIcon
Icone1Index = InfosFile\iIcon ; On récupère le numéro de 'licône dans l'image list
ImageGadget(0, 10, 10, 0, 0, Icone1)
TextGadget(#PB_Any, 10, 30, 100, 15, "SHGetFileInfo")

ExtractIconEx_(IconPath, IconIndex, 0, @Icone2, 1)
ImageGadget(1, 110, 10, 0, 0, Icone2)
TextGadget(#PB_Any, 110,30, 100, 15, "ExtractIconEx")

TrackBarGadget(10, 10, 80, 480, 20, 1, 255)
SetGadgetState(10, Transparency)
TextGadget(11, 10, 105, 290, 15, "icon transparency = " + Str(Transparency))

CreateImage(0, 16, 16)
HDC = StartDrawing(ImageOutput())
  Box(0, 0, 16, 16, GetSysColor_(#COLOR_3DFACE))
  ImageList_Draw_(hImageListS, Icone1Index, HDC, 0, 0, #ILD_TRANSPARENT) ; on dessine l'icône à partir de l'imagelist
StopDrawing()
ImageGadget(3, 210, 10, 16, 16, UseImage(0))
TextGadget(#PB_Any, 210, 30, 100, 30, "SHGetFileInfo + ImageList_Draw")

Icone3 = ImageList_GetIcon_(hImageListS, Icone1Index, #ILD_TRANSPARENT)
ImageGadget(4, 310, 10, 0, 0, Icone3)
TextGadget(#PB_Any, 310, 30, 100, 30, "SHGetFileInfo + ImageList_GetIcon")



Repeat
  Event = WaitWindowEvent()
  
  If Event = #PB_EventGadget
    Select EventGadgetID()
      Case 10
        DestroyIcon_(Icone1)
        DestroyIcon_(Icone2)
        DestroyIcon_(Icone3)
        DeleteFile("test" + Str(Transparency) + ".ico")
        
        Transparency = GetGadgetState(10)
        SetGadgetText(11, "icon transparency = " + Str(Transparency))
        
        CreateIcon(Transparency)
        IconPath.s = "test" + Str(Transparency) + ".ico"
        
        SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
        Icone1 = InfosFile\hIcon
        Icone1Index = InfosFile\iIcon
        SetGadgetState(0, Icone1)
        
        ExtractIconEx_(IconPath, IconIndex, 0, @Icone2, 1)
        SetGadgetState(1, Icone2)
        
        UseImage(0)
        HDC = StartDrawing(ImageOutput())
          Box(0, 0, 16, 16, GetSysColor_(#COLOR_3DFACE))
          ImageList_Draw_(hImageListS, Icone1Index, HDC, 0, 0, #ILD_TRANSPARENT)
        StopDrawing()
        SetGadgetState(3, UseImage(0))
        
        Icone3 = ImageList_GetIcon_(hImageListS, Icone1Index, #ILD_TRANSPARENT)
        SetGadgetState(4, Icone3)
        
        
        ; InvalidateRect_(WindowID(), 0, 1)
        ; UpdateWindow_(WindowID())
        
    EndSelect
  EndIf
  
Until Event = #PB_EventCloseWindow

DestroyIcon_(Icone1)
DestroyIcon_(Icone2)
DestroyIcon_(Icone3)
DeleteFile("test" + Str(Transparency) + ".ico")

End

Tu serais pas en train de nous faire (ou te faire

) un gestionnaire de raccourci?

C'est pour mon PopupMenu Editeur.

Donc la réponse est oui à moitié car le programme existe déjà, je suis sur la prochaine version. (l'aperçu ci-dessus, c'est un menu crée avec ce logiciel)