PureBasic

je me sert de cette fonction pour récupérer l'icône d'un fichier mais visiblement, elle est pas très compatible avec les icônes au format XP (avec les effet de fondu)
Certaine icône merdouille (notamment sur les effets de fondu avec une couleur blanche)

Code : Tout sélectionner

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

IconPath.s = "d:\"
; IconPath.s = "d:\test.txt"

SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON)
Icone = InfosFile\hicon
ImageGadget(1, 10, 10, 32, 32, Icone)

Repeat
  Event = WaitWindowEvent()
  
Until Event = #PB_EventCloseWindow

DestroyIcon_(Icone)

End

alors j'aimerai passé par la fonction ExtractIconEx qui marche sans problème.
mais je n'arrive pas à obtenir quelle est le fichier qui contient l'icône associé au fichier

Code : Tout sélectionner

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

IconPath.s = "d:\"
; IconPath.s = "d:\test.txt"

; J'essaie de récupérer l'icône du fichier
SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICONLOCATION)
Debug InfosFile\iIcon
Debug PeekS(@InfosFile\szDisplayName)
; mais ça ne marche pas dans tous les cas
; essayer avec un fichier texte par exemple

; ici, je charge l'icone
; la fonction ne marche qu'avec les *.ico *.exe ou *.dll
ExtractIconEx_(@InfosFile\szDisplayName, InfosFile\iIcon, @Icone, 0, 1)
ImageGadget(1, 10, 10, 32, 32, Icone)

Repeat
  Event = WaitWindowEvent()
  
Until Event = #PB_EventCloseWindow

DestroyIcon_(Icone)

End

une idée ?

Tu peux utiliser :
findexecutable ou ExtractAssociatedIcon

ExtractAssociatedIcon fonctionne sans pb avec l'icône mais ne renvoie que l'icône 32*32, donc il met inutile

findexecutable renvoie l'exe associé mais c'est pas forcé l'icone de l'exe qui est utilisé pour le fichier
par exemple, les fichiers textes, les raccourcis, etc...

c'est chiant quand le bug vient de chez MS, c'est toujours la galère pour trouver un paliatif (je suis sure que le bug est de MS car quand je copie mon icône, il me l'affichage avec les même défaut que dans mon exe dans la fenêtre de confirmation pour écraser un fichier)

Voici un aperçu de mon problème (sur XP uniquement)

il suffit de chnager la valeur de la variable Transparence au début du code comme indiqué.
il s'agit ici de faire varier le niveau de transparence de la couleur blanche je crée un icône (un fichier *.ico) de 32*32 pixel tout blanc avec un niveau de transparence
puis je l'affiche avec SHGetFileInfo_

Code : Tout sélectionner

; Param de couleur
CouleurImage = RGB(255, 255, 255)
Transparence = 128
; essayer avec 127 au leiu de 128 en transparence, normalement, ça doit pas changer grand chose une transparence de 128 et 127 mais ...
Masque = 0

; on crée l'icône
If CreateFile(0, "Test.ico")
  WriteLong(65536)
  WriteWord(1)
  
  WriteByte(32) ; Taille X
  WriteByte(32) ; Taille Y
  WriteLong(65536)
  WriteWord(32) ; Format 24 ou 32
  ; Taille de l'icone en octects
  WriteLong(4264)
  ; Position de l'icône dans le fichier
  WriteLong(22)
  
  WriteLong(40)
  WriteLong(32)
  WriteLong(64)
  
  WriteWord(1)
  WriteWord(32)
  
  WriteLong(0)
  
  WriteLong(4224)
  WriteLong(0)
  WriteLong(0)
  WriteLong(0)
  WriteLong(0)
  
  Taille = 32
  
  For n = Taille - 1 To 0 Step -1
    For nn = 0 To Taille - 1
      
      WriteByte(Blue(CouleurImage))
      WriteByte(Green(CouleurImage))
      WriteByte(Red(CouleurImage))
      
      ; Niveau de transparence de la couleur
      ; 0 = transparent
      ; 255 = opaque
      WriteByte(Transparence)
      
    Next
  Next
  
  For n = Taille - 1 To 0 Step -1
    Rang_Bit = 8
    MasqueBinaire.l = 0
    NbOctect = 0
    For nn = 0 To Taille - 1
      Rang_Bit - 1
      
      ; le masque est en binaire, un 1 signifie que le point est transparent
      If Masque
        MasqueBinaire = MasqueBinaire | ( %1 << Rang_Bit)
      EndIf
      
      If Rang_Bit = 0 Or nn = Taille - 1
        WriteByte(MasqueBinaire)
        Rang_Bit = 8
        MasqueBinaire = 0
        NbOctect + 1
      EndIf
      
    Next
    
    For nn = NbOctect To Round(NbOctect / 4, 1) * 4 - 1
      WriteByte(0)
    Next
    
  Next
  
  CloseFile(0)
EndIf

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

IconPath.s = GetProgramDirectory() + "test.ico"
SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON)
Debug PeekS( @InfosFile\szDisplayName)
Icone = InfosFile\hIcon
ImageGadget(0, 10, 10, 32, 32, Icone)

Repeat
  Event = WaitWindowEvent()
  
Until Event = #PB_EventCloseWindow

DestroyIcon_(Icone)

; on supprime le fichier créé
DeleteFile("Test.ico")

End

Je comprends pas trop comment ça marche, cette couleur de transprence, pourquoi ça vire vers le gris foncé. Mais bon si c'est normal ça a l'air de fonctionner jusqu'à la valeur 127. Je ne sais pas si 128 c'est complètement transparent où complètement opaque mais est-ce qu'on est pas dans un cas particulier puisque le blanc sert pour le masque. J'ai l'impression que c'est normal.

bon, j'ai trouvé une formule qui a l'air de marché pour la création des icônes. ça évite le problème avec la fonction SHFileInfo en rendant la couleur qui va planter complètement transparente

Code : Tout sélectionner

; Param de couleur 
Couleur = 254
Transparence = 65
; Je vous laisse changer ces 2 valeurs
; Pour la couleur de 255, la limite est de transparence est 128, en dessous, ça plante
; Pour la couleur de 254, la limite est de transparence est 65, en dessous, ça plante
; Pour la couleur de 253, la limite est de transparence est 43, en dessous, ça plante
; Etc ...


CouleurImage = RGB(Couleur , 0, 0)

CompilerIf 1 ; mettre 0 pour voir le problème et 1 pour y palier
  If Transparence < Int(127 / (256 - Couleur) + 1.5)
    Masque = 1
  Else
    Masque = 0
  EndIf
CompilerElse
  Masque = 0
CompilerEndIf

; on crée l'icône 
If CreateFile(0, "Test.ico") 
  WriteLong(65536) 
  WriteWord(1) 
  
  WriteByte(32) ; Taille X 
  WriteByte(32) ; Taille Y 
  WriteLong(65536) 
  WriteWord(32) ; Format 24 ou 32 
  ; Taille de l'icone en octects 
  WriteLong(4264) 
  ; Position de l'icône dans le fichier 
  WriteLong(22) 
  
  WriteLong(40) 
  WriteLong(32) 
  WriteLong(64) 
  
  WriteWord(1) 
  WriteWord(32) 
  
  WriteLong(0) 
  
  WriteLong(4224) 
  WriteLong(0) 
  WriteLong(0) 
  WriteLong(0) 
  WriteLong(0) 
  
  Taille = 32 
  
  For n = Taille - 1 To 0 Step -1 
    For nn = 0 To Taille - 1 
      
      WriteByte(Blue(CouleurImage)) 
      WriteByte(Green(CouleurImage)) 
      WriteByte(Red(CouleurImage)) 
      
      ; Niveau de transparence de la couleur 
      ; 0 = transparent 
      ; 255 = opaque 
      WriteByte(Transparence) 
      
    Next 
  Next 
  
  For n = Taille - 1 To 0 Step -1 
    Rang_Bit = 8 
    MasqueBinaire.l = 0 
    NbOctect = 0 
    For nn = 0 To Taille - 1 
      Rang_Bit - 1 
      
      ; le masque est en binaire, un 1 signifie que le point est transparent 
      If Masque 
        MasqueBinaire = MasqueBinaire | ( %1 << Rang_Bit) 
      EndIf 
      
      If Rang_Bit = 0 Or nn = Taille - 1 
        WriteByte(MasqueBinaire) 
        Rang_Bit = 8 
        MasqueBinaire = 0 
        NbOctect + 1 
      EndIf 
      
    Next 
    
    For nn = NbOctect To Round(NbOctect / 4, 1) * 4 - 1 
      WriteByte(0) 
    Next 
    
  Next 
  
  CloseFile(0) 
EndIf 

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

IconPath.s = GetProgramDirectory() + "test.ico" 
SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON) 
Debug PeekS( @InfosFile\szDisplayName) 
Icone = InfosFile\hIcon 
ImageGadget(0, 10, 10, 32, 32, Icone) 

Repeat 
  Event = WaitWindowEvent() 
  
Until Event = #PB_EventCloseWindow 

DestroyIcon_(Icone) 

; on supprime le fichier créé 
DeleteFile("Test.ico") 

End

J'aurais bien voulu voir le problème de départ sur une icône existante avec ton premier code, si tu pouvais refiler une icône représentant ce problème ou indiquer une icône que je pourrais récupérer dans un prog pour faire des tests.

oui, mais tant que mamadoo est en rade, je peux t'envoyer ça par mail ? Donne moi ton adresse par MP

en fait, je m'en suis aperçu en faisant une icône avec une bordure blanche
à certain endroit de la bordure, j'ai eu ce problème donc la bordure blanche était entaché de point de sombre.

Pas de Pb, je te l'ai envoyé en MP.

J'espère que tu arriveras à trouvé une solution, car moi, je bute depuis un moment.

c'est ennervant quand le problème viens de MS, la bidouille est pas forcément évidente pour y palier

Je vois pas de solution au problème, c'est bien la fonction elle-même qui pose problème, si j'ai bien compris la transparence s'applique au mask avec des niveaux de Gris donc le mask au lieu d'être définit sur 1 bit/pixel est définit sur 8 bits/pixel, c'est ça?

sur un icône XP, on a la couleur en 32bit définit en RGBT (rouge, vert, bleu, niveau de transparence) puis on a un masque 0 ou 1 définit sur 1bits
le masque ne sert à rien sur XP normalement mais permet la compatibilité sur win 98/2000

le niveau de transparence est compris entr 0 et 255 comme le rouge, vert ou bleu. 0 c'est transparent, 255 opaque

J'ai chargé ton icone avec snicon edit , et le masque était en niveau de gris, je ne sais pas comment fonctionne ce logiciel.

si on extrait la composante T de la couleur RGBT 32bits, on obtient un masque en niveau de gris

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 ?