Ne voulant pas polluer les autres topic en cours sur ce sujet, je met dans "Trucs et astuces", une autres méthode pour affiché les icônes en fonction de l'extension du nom d'un fichier... Pour l'affichage de l'icone par défaut, je la charge par une autre méthode dans la DLL "shell32.dll", pour avoir bien celle de l'OS par défaut.
Le petit problème de cette source et les quelques secondes au chargement. Par contre avec beaucoup de fichier a vérifier cette méthode est beaucoup plus rapide pour l'affichage d'une icône.
Code : Tout sélectionner
; +======================================================+
; | CHARGEMENT DES ICONES (Réalisation par KoakDesign) |
; +------------------------------------------------------+
; | COPYRIGHT(C)2007-2013, ALL RIGHT RESERVED KOAKDESIGN |
; +--------------+---------------------------------------+
; | Program type | PUREBASIC 4.40 |
; +--------------+---------------------------------------+
; | VER & REV | 0.0.1 |
; +--------------+---------------------------------------+
; | Program name | include_loadicon.pbi |
; +======================================================+
; +======================================================+
; | Original Version: 0.0.1 |
; +--------------+---------------------------------------+
; | Created by | |
; | Graphix by | |
; +--------------+---------------------------------------+
; | Comments: | |
; +--------------+ |
; | |
; | |
; | |
; +======================================================+
; +======================================================+
; | Système d'Exploitation |
; +--------------+---------------------------------------+
; | Window | Oui |
; | Linux | Non |
; | MacOS | Non |
; +======================================================+
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; +--------------------------------------------------------------------------+
; | |
; +--------------------------------------------------------------------------+
EnableExplicit
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; +--------------------------------------------------------------------------+
; | |
; +--------------------------------------------------------------------------+
Structure SHELLICONLIST
hLarge.i
hSmall.i
szTypeName.s
EndStructure
Global numicon.i
Global Dim silist.SHELLICONLIST(0)
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; +--------------------------------------------------------------------------+
; | |
; +--------------------------------------------------------------------------+
Procedure.l GetFileTypeIcon(szName.s, blarge.b = #False)
; ROUTINE DE RECHERCHE DES ICONES PAR EXTENTION.
Define i.l
Define j.l = 0
If Left(szName, 1) <> "."
szName = "." + szName
EndIf
For i=0 To numicon
If LCase(szName) = silist(i)\szTypeName
j = i
Break
EndIf
Next i
If j > 0
If blarge = #False
ProcedureReturn silist(i)\hSmall
Else
ProcedureReturn silist(i)\hLarge
EndIf
Else
;
; ICI ICONE PAR DEFAUT.
;
;If blarge = #False
; ProcedureReturn ICON_DISK05
;Else
; ProcedureReturn ICON_DISK06
;EndIf
;
; ICI ICONE PAR DEFAUT.
;
EndIf
EndProcedure
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; +--------------------------------------------------------------------------+
; | |
; +--------------------------------------------------------------------------+
Procedure SetDestroyIcon()
; ROUTINE D'EFFACEMENT DES ICONES EN MEMOIRE.
Define i.l
For i=1 To numicon
DestroyIcon_(silist(i)\hSmall)
DestroyIcon_(silist(i)\hLarge)
Next i
FreeArray(silist())
EndProcedure
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; +--------------------------------------------------------------------------+
; | |
; +--------------------------------------------------------------------------+
Define hKey.l
If(RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer", 0, #KEY_ALL_ACCESS, @hKey) = #ERROR_SUCCESS)
Define buffer.s = Space(64)
Define bufferlen.i = 64
RegQueryValueEx_(hKey, "Version", #Null, #Null, @buffer.s, @bufferlen)
EndIf
RegCloseKey_(hKey)
If Mid(buffer,0,4)="6.0."
If(RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{f39a0dc0-9cc8-11d0-a599-00c04fd64433}\InProcServer32", 0, #KEY_ALL_ACCESS, @hKey) = #ERROR_SUCCESS)
Define dwSize.l = 256
Define szValue.s = Space(256)
If(RegQueryValue_(hKey, #NULL$, @szValue, @dwSize) = #ERROR_SUCCESS)
numicon + 1
ReDim silist.SHELLICONLIST(numicon)
ExtractIconEx_(szValue, 2, @silist(numicon)\hLarge, @silist(numicon)\hSmall, 1)
silist(numicon)\szTypeName = ".cdf"
EndIf
EndIf
RegCloseKey_(hKey)
EndIf
If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, #NULL$, 0, #KEY_ENUMERATE_SUB_KEYS, @hKey) = #ERROR_SUCCESS
Define dwIndex.i
Define szName.s = Space(#MAX_PATH)
Define dwBuf.i = #MAX_PATH
Define shInfo.SHFILEINFO
While(RegEnumKey_(hKey , dwIndex, @szName, @dwBuf) = 0)
dwIndex + 1
If Mid(szName, 0, 1) = "." And Len(szName) > 1
If szName <> ".cdf"
numicon + 1
ReDim silist.SHELLICONLIST(numicon)
SHGetFileInfo_(szName, #FILE_ATTRIBUTE_NORMAL, @shInfo, SizeOf(SHFILEINFO), #SHGFI_USEFILEATTRIBUTES | #SHGFI_ICON | #SHGFI_SMALLICON)
silist(numicon)\hSmall = shInfo\hIcon
SHGetFileInfo_(szName, #FILE_ATTRIBUTE_NORMAL, @shInfo, SizeOf(SHFILEINFO), #SHGFI_USEFILEATTRIBUTES | #SHGFI_ICON | #SHGFI_LARGEICON)
silist(numicon)\hLarge = shInfo\hIcon
silist(numicon)\szTypeName = LCase(szName)
EndIf
EndIf
Wend
EndIf
RegCloseKey_(hKey)
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
; +--------------------------------------------------------------------------+
; | |
; +--------------------------------------------------------------------------+
Enumeration
#Mainform
#FileExplorer
EndEnumeration
Define event.i
OpenWindow(#Mainform, 0, 0, 500, 400, "Ftp Demo", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
ListIconGadget(#FileExplorer, 10, 10, 480, 380, "File", 200, #PB_ListIcon_FullRowSelect )
;
; Pour l'utilisation pour la procedure "GetFileTypeIcon()" mettre à "szName" l'extension du fichier (genre *.bmp).
; blarge est True ou False et permet de mettre en 16x16 ou 32x32 l'icone.
;
; PS : On peut utilisé "GetExtensionPart()" pour avoir l'extension d'in nom de fichier.
;
; Quelque exemple pour montré comme cela fontionne :
;
AddGadgetItem(#FileExplorer, -1, "image.bmp", GetFileTypeIcon("bmp"))
AddGadgetItem(#FileExplorer, -1, "fichier.pb", GetFileTypeIcon(".pb"))
AddGadgetItem(#FileExplorer, -1, "autrefichier.jpg", GetFileTypeIcon(GetExtensionPart("autrefichier.jpg")))
Repeat
event = WaitWindowEvent(10)
Until event = #PB_Event_CloseWindow
;
; On supprime bien touts les icones :).
;
SetDestroyIcon()
GallyHC
.
