Dessiner l'icone associée à une extension de fichier

Francis Morel propose sur son nouveau site un exemple de fenêtre qui permet d'extraire une icone d'un exécutable (ou bibliothèque) http://softprotect.canalblog.com/archives/2008/11/02/11228525.html#11228525

Je vous propose une procédure complémentaire pour Windev qui vous permet de récupérer l'icone utilisée dans l'explorateur windows pour un type de fichier donné...

// Résumé : Dessine l'icone associée à une extension de fichier, ou d'un fichier en particulier
// Paramètres : 
//      sFileName (chaîne) : Nom du fichier ou extension avec le "." (ex: ".doc")
//      sNomChpImage (chaîne - valeur par défaut="") : Nom du Champ Image
//      hDC (entier système - valeur par défaut=0) : ou hDC du champ image renvoyé par dDebutDessin()
//      nTaille (entier - valeur par défaut=16) : 16, 32, 48, 64 
// Valeur de retour : 
//      booléen
//
// Exemples :
// DessineIconeFichier(".doc",IMG_Icone..Nom)
// DessineIconeFichier("C:\Test.exe","",hDC)
 
PROCEDURE DessineIconeFichier(sFileName est chaîne, LOCAL sNomChpImage est chaîne="", ...
                                                        LOCAL hDC est entier système=0, nTaille est entier = 16)
        
SI sNomChpImage<>"" _ET_ PAS ChampExiste(sNomChpImage) ALORS
        RENVOYER Faux
FIN
 
sDefaultIcon est chaîne = SysRep(srSystème) + "\SHELL32.DLL"
nIconIndex est entier
sFileExt est chaîne
sContentType est chaîne
sProgramName est chaîne
nbIcons,nIndex,nError sont entier
hIcon est entier système
 
sFileExt = Minuscule(fExtraitChemin(sFileName,fExtension))
 
SELON sFileExt
        CAS ".ico"
                SI fFichierExiste(sFileName) ALORS
                        sDefaultIcon=sFileName
                        GOTO DRAW_ICON
                FIN
        CAS ".exe"
                //sDefaultIcon = SysRep(srSystème) + "\SHELL32.DLL"
                nIconIndex = 2
                //Icone de l'executable (si nom de fichier complet fourni)
                SI fFichierExiste(sFileName) ALORS
                        sDefaultIcon=sFileName
                        nIconIndex = 0
                        GOTO DRAW_ICON
                FIN
FIN
 
//Icone par appli
sProgramName = RegistreLit("HKEY_CURRENT_USER\Software\Classes\"+sFileExt,0) // 0: (par défaut)
SI sProgramName = "" ALORS
        sProgramName = RegistreLit("HKEY_CLASSES_ROOT\"+sFileExt,0)
FIN
sDefaultIcon = RegistreLit("HKEY_CURRENT_USER\Software\Classes\"+sProgramName + "\DefaultIcon",0)
SI sDefaultIcon = "" ALORS
        sDefaultIcon = RegistreLit("HKEY_CLASSES_ROOT\"+sProgramName + "\DefaultIcon",0)
FIN
//Icone par content/type
SI sDefaultIcon = "" ALORS
        sContentType = RegistreLit("HKEY_CLASSES_ROOT\"+sFileExt,"Content Type")
        SI sContentType <> "" ALORS
                sFileExt=RegistreLit("HKEY_CLASSES_ROOT\MIME\Database\Content Type\"+sContentType,"Extension")
                sProgramName = RegistreLit("HKEY_CURRENT_USER\Software\Classes\"+sFileExt,0)
                SI sProgramName = "" ALORS
                        sProgramName = RegistreLit("HKEY_CLASSES_ROOT\"+sFileExt,0)
                FIN
                sDefaultIcon = RegistreLit("HKEY_CURRENT_USER\Software\Classes\"+sProgramName + "\DefaultIcon",0)
                SI sDefaultIcon = "" ALORS
                        sDefaultIcon = RegistreLit("HKEY_CLASSES_ROOT\"+sProgramName + "\DefaultIcon",0)
                FIN
        FIN
FIN
SI sDefaultIcon<>"" ALORS
        nIndex = Position(sDefaultIcon, ",", Taille(sDefaultIcon), DepuisFin)
        SI nIndex ALORS
                nIconIndex = sDefaultIcon[[nIndex+1 A]]
                sDefaultIcon = sDefaultIcon[[A nIndex-1]]
        FIN
FIN
 
DRAW_ICON:
SI nTaille=16 ALORS
        //Petite icone
        nbIcons = API("SHELL32","ExtractIconExA", sDefaultIcon, nIconIndex, Null, &hIcon, 1)
SINON
        //Icone standard
        hIcon = API("SHELL32","ExtractIconA", 0, sDefaultIcon, nIconIndex)      
FIN
 
SI hIcon DANS (-1,0,1) ALORS
        RENVOYER Faux
FIN
 
SI sNomChpImage<>"" ALORS
        {sNomChpImage,indChamp}..Visible=Faux 
        hDC = dDébutDessin(sNomChpImage)
        nError = API("USER32","DrawIconEx",hDC, 0, 0, hIcon, nTaille, nTaille, 0, 0, 3)
        {sNomChpImage,indChamp}..Visible=Vrai 
SINON
        nError = API("USER32","DrawIconEx",hDC, 0, 0, hIcon, nTaille, nTaille, 0, 0, 3) 
FIN
 
API("USER32","DestroyIcon",hIcon)
 
RENVOYER Vrai

Commentaires

Options d'affichage des commentaires

Sélectionnez la méthode d'affichage des commentaires que vous préférez, puis cliquez sur "Sauvegarder les paramètres" pour activer vos changements.

Bonjour, Merci pour ce code,

Bonjour,
Merci pour ce code, il marche super sous XP !
Auriez-vous une version "actualisée" pour Vista/Seven ? Je suis sous Vista et je ne peut voir que les icônes de Office et celle du média player, je n'arrive pas à afficher l'icone d'Acrobat Reader, des fichiers textes, etc

D'avance, merci

MikA

voilà mis à jour pour vista

voilà mis à jour pour vista et seven... le code fonctionnait, mais il y a de nouveaux cas possibles

merci beaucoup pour le code,

merci beaucoup pour le code, c'est d' haute gamme
bravo

Merci pour ce code vraiment

Merci pour ce code vraiment pratique.
Juste un petit soucis avec les tailles d'icones, les tailles 16,32 fonctionne, mais les tailles 48 et 64 pixelise (icone 32 agrandi ?)
Ca n'affiche pas non plus les icone de fichier PDF.
Donc si vous aves une idée.