This routine is by far the most powerfull, simple and robust routine for indexing of shellicons I have come up with for FS objects as well as Virtual objects. Works from Win XP and above. And no need of any typelibs.
Also very effortless in memory usage. No time & memory consuming extractions at all.
So get rid of your existing routines and replace it with this tiny one.
Handle both normal and open icons.
You can also use it for all sizes you wish ie small, medium, large, extra large or custom size. (It handles "under the hood" IImageList interface which allows resizing on the fly without clearing the imagelist).
Happy Coding :wave:;)
Also very effortless in memory usage. No time & memory consuming extractions at all.
So get rid of your existing routines and replace it with this tiny one.
Handle both normal and open icons.
You can also use it for all sizes you wish ie small, medium, large, extra large or custom size. (It handles "under the hood" IImageList interface which allows resizing on the fly without clearing the imagelist).
Code:
Public Const S_OK = 0&
Public Const S_ERR = 1
Public Declare Function SHGetDesktopFolder Lib "shell32.dll" (ByRef ppshf As Long) As Long
Public Declare Function SHMapPIDLToSystemImageListIndex Lib "shell32.dll" (Byref pshf As Long, ByVal pidl As Long,Byref piIndex As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pidlorMem As Long)
Public Function IID_IShellFolder() As GUID
Dim lpIID As GUID
'000214E6-0000-0000-C000-000000000046
lpIID.Data1 = &H214E6
lpIID.Data2 = &H0
lpIID.Data3 = &H0
lpIID.Data4(0) = &HC0
lpIID.Data4(1) = &H0
lpIID.Data4(2) = &H0
lpIID.Data4(3) = &H0
lpIID.Data4(4) = &H0
lpIID.Data4(5) = &H0
lpIID.Data4(6) = &H0
lpIID.Data4(7) = &H46
IID_IShellFolder = lpIID
End Function
Public Function SHGetItemIconIndex(ByVal pidlItem As Long, ByRef nIconIndex As Long, Optional nOpenIconIndex As Long) As Long
Dim pidl As Long
Dim pidlChild As Long
Dim ppISF As Long
Dim nIconSize As Long
Dim sIconFile As String
pidl = pidlItem
If pidl Then
'You can put in if statement here if you feel for it. (If hr = S_OK Then)
SHBindToParent pidl, IID_IShellFolder, ppISF, pidlChild
If ppISF = 0 Then SHGetDesktopFolder ppISF
nIconIndex = SHMapPIDLToSystemImageListIndex(ByVal ppISF, pidlChild, nOpenIconIndex)
Debug.Print "nIconIndex: " & nIconIndex
Debug.Print "nOpenIconIndex: " & nOpenIconIndex
CoTaskMemFree pidl
CoTaskMemFree ppISF
ppISF = 0
If (nIconIndex <> -1) And (nOpenIconIndex <> -1) Then
SHGetItemIconIndex = S_OK
Else
SHGetItemIconIndex = S_ERR
End If
End If