Code : Tout sélectionner
#SHIL_SMALL = $1
#SHIL_LARGE = $0
#SHIL_EXTRALARGE = $2
#SHIL_JUMBO = $4
#LOAD_LIBRARY_AS_DATAFILE = 2
DataSection
IID_IImageList:
Data.l $46EB5926
Data.w $582E,$4017
Data.b $9F,$DF,$E8,$99,$8D,$AA,$09,$50
EndDataSection
Structure IMAGELISTDRAWPARAMS
cbSize.l
himl.l
i.l
hdcDst.l
x.l
y.l
cx.l
cy.l
xBitmap.l
yBitmap.l
rgbBk.l
rgbFg.l
fStyle.l
dwRop.l
fState.l
frame.l
crEffect.l
EndStructure
Interface IImageList2 Extends iUnknown
Add(hbmImage, hbmMask, pi)
ReplaceIcon(i, hIcon, pi)
SetOverlayImage(iImage, iOverlay)
Replace(i, hbmImage, hbmMask)
AddMasked(hbmImage, crMask, pi)
Draw(pimldp.IMAGELISTDRAWPARAMS)
Remove(i)
GetIcon(i, flags, picon)
GetImageInfo(i, pImageInfo.IMAGEINFO)
Copy(iDst, punkSrc.IImageList, iSrc, uFlags)
Merge(i1, punk2.IImageList, i2, dx, dy, riid, ppv)
Clone(riid, ppv)
GetImageRect(i, prc.RECT)
GetIconSize(cx, cy)
SetIconSize(cx, cy)
GetImageCount(pi)
SetImageCount(uNewCount)
SetBkColor(clrBk, pclr)
GetBkColor(pclr)
BeginDrag(iTrack, dxHotspot, dyHotspot)
EndDrag()
DragEnter(hwndLock, x, y)
DragLeave(hwndLock)
DragMove(x, y)
SetDragCursorImage(punk.IImageList, iDrag, dxHotspot, dyHotspot)
DragShowNolock(fShow)
GetDragImage(ppt.POINT, pptHotspot.POINT, riid, ppv)
GetItemFlags(i, dwFlags)
GetOverlayImage(iOverlay, piIndex)
EndInterface
Global OS
ProcedureDLL GetIcon_Init()
OS = OSVersion()
EndProcedure
ProcedureDLL.l GetIconFile(IconFile.s, Size.l) ; Get icon 16*16, 32*32 or 48*48
Protected hIcon.l, FileInfo.SHFILEINFO, dll_Shell32.l, hResult.l, *Guid.l
Select Size
Case #SHIL_SMALL, 16
SHIL = #SHIL_SMALL
Case #SHIL_LARGE, 32
SHIL = #SHIL_LARGE
Case #SHIL_EXTRALARGE, 48
SHIL = #SHIL_EXTRALARGE
Case #SHIL_JUMBO, 128, 256
If OS >= #PB_OS_Windows_Vista
SHIL = #SHIL_JUMBO
Else
SHIL = #SHIL_EXTRALARGE
EndIf
Default
SHIL = #SHIL_SMALL
EndSelect
If OS >= #PB_OS_Windows_XP ; Pour Windows XP et plus, toute taille d'icône
dll_Shell32 = OpenLibrary(#PB_Any, "Shell32.dll")
If dll_Shell32
*Guid = ?IID_IImageList
SHGetFileInfo_(IconFile, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX)
hResult = CallFunction(dll_Shell32, "SHGetImageList", SHIL, *Guid, @ImageList.IImageList2)
If hResult = 0
ImageList\GetIcon(FileInfo\iIcon, #ILD_TRANSPARENT, @hIcon)
ImageList\Release()
EndIf
CloseLibrary(dll_Shell32)
EndIf
Else ; Avant windows XP, icône 16*16 ou 32*32
If SHIL = #SHIL_EXTRALARGE Or SHIL = #SHIL_LARGE
SHGetFileInfo_(IconFile, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_LARGEICON)
hIcon = InfosFile\hIcon
Else
SHGetFileInfo_(IconFile, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
hIcon = InfosFile\hIcon
EndIf
EndIf
ProcedureReturn hIcon
EndProcedure
ProcedureDLL.l GetSmallIconFile(IconFile.s) ; Get icon 16*16
; Cette procedure permet d'extraire l'ID de l'icône 16*16 associée au type de fichier ou au dossier dont l'adresse est IconFile
ProcedureReturn GetIconFile(IconFile.s, 16)
EndProcedure
ProcedureDLL.l GetLargeIconFile(IconFile.s) ; Get icon 32*32
; Cette procedure permet d'extraire l'ID de l'icône 32*32 associée au type de fichier ou au dossier dont l'adresse est IconFile
ProcedureReturn GetIconFile(IconFile.s, 32)
EndProcedure
ProcedureDLL.l GetExtraLargeIconFile(IconFile.s) ; Get icon 48*48
; Cette procedure permet d'extraire l'ID de l'icône 48*48 associée au type de fichier ou au dossier dont l'adresse est IconFile
ProcedureReturn GetIconFile(IconFile.s, 48)
EndProcedure
ProcedureDLL.l GetJumboIconFile(IconFile.s) ; Get icon 128*128 or 256*256
; Cette procedure permet d'extraire l'ID de l'icône 128*128 ou 256*256 associée au type de fichier ou au dossier dont l'adresse est IconFile
ProcedureReturn GetIconFile(IconFile.s, 128)
EndProcedure
Procedure GetIconIndexList_Enumerate(hLibrary, lpszType, lpszName, *Memory.Long)
Protected Result.l, Name.s
*Memory\l = ReAllocateMemory(*Memory\l, MemorySize(*Memory\l) + 4)
If *Memory\l
If lpszName >> 16
Name = PeekS(lpszName)
lpszName = AllocateMemory(StringByteLength(Name + "0"))
Debug Name
PokeS(lpszName, Name)
EndIf
Debug lpszName
PokeL(*Memory\l + MemorySize(*Memory\l) - 8, lpszName)
Result = #True
Else
Result = #False
EndIf
ProcedureReturn Result
EndProcedure
ProcedureDLL.l GetIconIndexList(IconFile.s) ; Get icon index list
Protected hLibrary, Memory.l
hLibrary = LoadLibraryEx_(IconFile, #NULL, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary <> #NULL
*Memory = AllocateMemory(4)
If *Memory
EnumResourceNames_(hLibrary, #RT_GROUP_ICON, @GetIconIndexList_Enumerate(), @*Memory)
EndIf
FreeLibrary_(hLibrary)
EndIf
ProcedureReturn *Memory
EndProcedure
ProcedureDLL FreeIconIndexList(Memory.l) ; Free icon index list
Protected Index.l, Value.l
Index = 0
Repeat
Value = PeekL(Memory + Index * 4) ; Numéro de l'icône
If Value > 0
If Value >> 16
FreeMemory(Value)
EndIf
Index + 1
EndIf
Until Value = 0
FreeMemory(Memory)
EndProcedure
ProcedureDLL ExtractIconFile(IconFile.s, IconIndex.l, Size.l) ; Extract icon from library or exe
Protected hLibrary, hIcon.l
If IconIndex > 0
hLibrary = LoadLibraryEx_(IconFile, #Null, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary <> #Null
If IconIndex >> 16
hIcon = LoadImage_(hLibrary, PeekS(IconIndex), #IMAGE_ICON, Size, Size, 0)
Else
hIcon = LoadImage_(hLibrary, IconIndex & $FFFF, #IMAGE_ICON, Size, Size, 0)
EndIf
FreeLibrary_(hLibrary)
EndIf
Else
hIcon = GetIconFile(IconFile, Size)
EndIf
ProcedureReturn hIcon
EndProcedure
ProcedureDLL ExtractSmallIconFile(IconFile.s, IconIndex.l) ; Extract icon 16*16 from library or exe
ProcedureReturn ExtractIconFile(IconFile.s, IconIndex.l, 16)
EndProcedure
ProcedureDLL ExtractLargeIconFile(IconFile.s, IconIndex.l) ; Extract icon 32*32 from library or exe
ProcedureReturn ExtractIconFile(IconFile.s, IconIndex.l, 32)
EndProcedure
ProcedureDLL ExtractExtraLargeIconFile(IconFile.s, IconIndex.l) ; Extract icon 48*48 from library or exe
ProcedureReturn ExtractIconFile(IconFile.s, IconIndex.l, 48)
EndProcedure
ProcedureDLL.l GetSpecialFolderIcon(CSIDL.l, Size.l) ; Get special folder icon
Protected hIcon.l, FileInfo.SHFILEINFO, dll_Shell32.l, hResult.l, *Guid.l, IconFile.l
Select Size
Case #SHIL_SMALL, 16
SHIL = #SHIL_SMALL
Case #SHIL_LARGE, 32
SHIL = #SHIL_LARGE
Case #SHIL_EXTRALARGE, 48
SHIL = #SHIL_EXTRALARGE
Case #SHIL_JUMBO, 128, 256
If OS >= #PB_OS_Windows_Vista
SHIL = #SHIL_JUMBO
Else
SHIL = #SHIL_EXTRALARGE
EndIf
Default
SHIL = #SHIL_SMALL
EndSelect
If SHGetSpecialFolderLocation_(0, CSIDL, @IconFile) = 0
If OS >= #PB_OS_Windows_XP ; Pour Windows XP et plus, toute taille d'icône
dll_Shell32 = OpenLibrary(#PB_Any, "Shell32.dll")
If dll_Shell32
*Guid = ?IID_IImageList
SHGetFileInfo_(IconFile, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_PIDL)
hResult = CallFunction(dll_Shell32, "SHGetImageList", SHIL, *Guid, @ImageList.IImageList2)
If hResult = 0
ImageList\GetIcon(FileInfo\iIcon, #ILD_TRANSPARENT, @hIcon)
ImageList\Release()
EndIf
CloseLibrary(dll_Shell32)
EndIf
Else ; Avant windows XP, icône 16*16 ou 32*32
If SHIL = #SHIL_EXTRALARGE Or SHIL = #SHIL_LARGE
SHGetFileInfo_(IconFile, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_PIDL | #SHGFI_LARGEICON)
hIcon = InfosFile\hIcon
Else
SHGetFileInfo_(IconFile, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_PIDL | #SHGFI_SMALLICON)
hIcon = InfosFile\hIcon
EndIf
EndIf
EndIf
ProcedureReturn hIcon
EndProcedure
ProcedureDLL.l GetSpecialFolderSmallIcon(CSIDL.l) ; Get special folder icon 16*16
ProcedureReturn GetSpecialFolderIcon(CSIDL.l, 16)
EndProcedure
ProcedureDLL.l GetSpecialFolderLargeIcon(CSIDL.l) ; Get special folder icon 32*32
ProcedureReturn GetSpecialFolderIcon(CSIDL.l, 32)
EndProcedure
ProcedureDLL.l GetSpecialFolderExtraLargeIcon(CSIDL.l) ; Get special folder icon 48*48
ProcedureReturn GetSpecialFolderIcon(CSIDL.l, 48)
EndProcedure
ProcedureDLL.l GetSpecialFolderJumboIcon(CSIDL.l) ; Get special folder icon 128*128 or 256*256
ProcedureReturn GetSpecialFolderIcon(CSIDL.l, 128)
EndProcedure