I'm trying to use Internet History in one LV Group and in second LV Group are the system drives populated.
So good so far but I'm not able to set neither Header text or iTitleImage Image for that second group. Even if the icon and name are from resources. Icon becomes 0 and the string becomes null...I'm confused.
I have tried to empty the LVGROUP Type before setting new info but this doesn't work. I have tried with following but nothing works..
So what I lack or missing is "This Computer" string and it's associated icon which I have in store but I'm not able to put it into the LVGROUP Type.
So good so far but I'm not able to set neither Header text or iTitleImage Image for that second group. Even if the icon and name are from resources. Icon becomes 0 and the string becomes null...I'm confused.
I have tried to empty the LVGROUP Type before setting new info but this doesn't work. I have tried with following but nothing works..
Code:
vbaCopyBytesZero ByVal 0, lpLVGRP, lpLVGRP
FillMemory lpLVGRP, ByVal LenB(lpLVGRP), ByVal 0Code:
Public Function EnumLVItem(ByVal pidlRoot As Long, ucLV As ucBrowseForFolderList, Optional iCount As Integer, Optional ByVal iGroupId As Integer = -1) As Long
Dim pidlParent As Long
Dim pidlEnum As Long
Dim pidlChild As Long
Dim pidlCombine As Long
Dim pISI As IShellItem
Dim pISI2 As IShellItem2
Dim pISI_child As IShellItem
Dim pISIA As IShellItemArray
Dim pIPAI As IParentAndItem
Dim pISM As IShellMenu
Dim pISF As IShellFolder2
Dim pEIDL As IEnumIDList
Static BHID_StorageEnum As UUID
Dim pIESHI As IEnumShellItems
Dim hr As Long
Dim lpName As Long
Dim lpNameRoot As Long
Dim sName As String
Dim sNameRoot As String
Dim sTypeName As String
Dim sExt As String
Dim hIcon As Long
Dim hNode As Long
Dim iIconIndex As Long
Dim iRootIcon As Integer
Dim dwAttribs As Long
Dim hWndIL As Long
Dim i As Integer
' hWndIL = ObjPtr(GetIImageList2(SHIL_SMALL))
'
' Call SendMessage(g_hWndTV, TVM_SETIMAGELIST, ByVal TVSIL_NORMAL, ByVal hWndIL)
iCount = 0
hr = SHCreateItemFromIDList(pidlRoot, IID_IShellItem, pISI)
'IIDFromString StrPtr("{4621A4E3-F0D6-4773-8A9C-46E77B174840}"), BHID_StorageEnum
'BHID_EnumItems
hr = pISI.BindToHandler(0, BHID_EnumItems, IID__IEnumShellItems, pIESHI)
'hr = pISI.BindToHandler(0, BHID_SFObject, IID__IShellFolder, pISF)
'pISF.EnumObjects 0, SHCONTF_FOLDERS Or SHCONTF_NONFOLDERS Or SHCONTF_STORAGE, pEIDL
'Do While pEIDL.Next(1, pidlEnum, 0) = S_OK
On Error GoTo err_out
sNameRoot = ""
lpNameRoot = 0
' pidlRoot = 0
Do While pIESHI.Next(1, pISI_child, 0) = S_OK
DoEvents
Set pIPAI = pISI_child
Set pISI2 = pISI_child
pIPAI.GetParentAndItem pidlParent, pISF, pidlChild
pISI_child.GetDisplayName SIGDN_NORMALDISPLAY, lpName
pidlEnum = GetPIDLFromObject(pISI_child)
iIconIndex = GetItemIconIndex(pidlEnum, False)
'GetIShellLibrary pidlEnum <---- HOW TO JUMP OVER THE AUTOMATION ERROR?
sNameRoot = ""
lpNameRoot = 0
SHGetNameFromIDList pidlRoot, SIGDN_NORMALDISPLAY, lpNameRoot
sNameRoot = StrConv(SysAllocString(lpNameRoot), vbFromUnicode)
iRootIcon = GetItemIconIndex(pidlRoot, False)
ucLV.AddGroup iGroupId, sNameRoot, iRootIcon, "Bibliotekets Mappar - Fälls ut eller fälls in via pilikonen i högra hörnet."
SHGetNameFromIDList pidlEnum, SIGDN_NORMALDISPLAY, lpName
sName = StrConv(SysAllocString(lpName), vbFromUnicode)
ucLV.AddItems iCount, sName, iIconIndex, iGroupId, pidlEnum
CoTaskMemFree pidlEnum
' 'CoTaskMemFree pidlChild
CoTaskMemFree pidlCombine
CoTaskMemFree lpName
CoTaskMemFree lpNameRoot
Set pISF = Nothing
Set pISI_child = Nothing
Set pIPAI = Nothing
iCount = iCount + 1
SHUpdateImageW StrPtr(sName), iIconIndex, &H2, iIconIndex
iIconIndex = Shell_GetCachedImageIndexW(lpName, iIconIndex, 0&)
lpNameRoot = 0
pidlRoot = 0
lpName = 0
sNameRoot = 0
Loop
err_out:
Debug.Print Err.Number & " , " & Err.Description
End Function
Public Function EnumLVItem(ByVal pidlRoot As Long, ucLV As ucBrowseForFolderList, Optional iCount As Integer, Optional ByVal iGroupId As Integer = -1) As Long
Dim pidlParent As Long
Dim pidlEnum As Long
Dim pidlChild As Long
Dim pidlCombine As Long
Dim pISI As IShellItem
Dim pISI2 As IShellItem2
Dim pISI_child As IShellItem
Dim pISIA As IShellItemArray
Dim pIPAI As IParentAndItem
Dim pISM As IShellMenu
Dim pISF As IShellFolder2
Dim pEIDL As IEnumIDList
Static BHID_StorageEnum As UUID
Dim pIESHI As IEnumShellItems
Dim hr As Long
Dim lpName As Long
Dim lpNameRoot As Long
Dim sName As String
Dim sNameRoot As String
Dim sTypeName As String
Dim sExt As String
Dim hIcon As Long
Dim hNode As Long
Dim iIconIndex As Long
Dim iRootIcon As Integer
Dim dwAttribs As Long
Dim hWndIL As Long
Dim i As Integer
' hWndIL = ObjPtr(GetIImageList2(SHIL_SMALL))
'
' Call SendMessage(g_hWndTV, TVM_SETIMAGELIST, ByVal TVSIL_NORMAL, ByVal hWndIL)
iCount = 0
hr = SHCreateItemFromIDList(pidlRoot, IID_IShellItem, pISI)
'IIDFromString StrPtr("{4621A4E3-F0D6-4773-8A9C-46E77B174840}"), BHID_StorageEnum
'BHID_EnumItems
hr = pISI.BindToHandler(0, BHID_EnumItems, IID__IEnumShellItems, pIESHI)
'hr = pISI.BindToHandler(0, BHID_SFObject, IID__IShellFolder, pISF)
'pISF.EnumObjects 0, SHCONTF_FOLDERS Or SHCONTF_NONFOLDERS Or SHCONTF_STORAGE, pEIDL
'Do While pEIDL.Next(1, pidlEnum, 0) = S_OK
On Error GoTo err_out
sNameRoot = ""
lpNameRoot = 0
Do While pIESHI.Next(1, pISI_child, 0) = S_OK
DoEvents
Set pIPAI = pISI_child
Set pISI2 = pISI_child
pIPAI.GetParentAndItem pidlParent, pISF, pidlChild
pISI_child.GetDisplayName SIGDN_NORMALDISPLAY, lpName
pidlEnum = GetPIDLFromObject(pISI_child)
iIconIndex = GetItemIconIndex(pidlEnum, False)
'GetIShellLibrary pidlEnum <---- HOW TO JUMP OVER THE AUTOMATION ERROR?
sNameRoot = ""
lpNameRoot = 0
SHGetNameFromIDList pidlRoot, SIGDN_NORMALDISPLAY, lpNameRoot
sNameRoot = StrConv(SysAllocString(lpNameRoot), vbFromUnicode)
iRootIcon = GetItemIconIndex(pidlRoot, False)
ucLV.AddGroup iGroupId, sNameRoot, iRootIcon, "Bibliotekets Mappar - Fälls ut eller fälls in via pilikonen i högra hörnet."
SHGetNameFromIDList pidlEnum, SIGDN_NORMALDISPLAY, lpName
sName = StrConv(SysAllocString(lpName), vbFromUnicode)
ucLV.AddItems iCount, sName, iIconIndex, iGroupId, pidlEnum
CoTaskMemFree pidlEnum
' 'CoTaskMemFree pidlChild
CoTaskMemFree pidlCombine
CoTaskMemFree lpName
CoTaskMemFree lpNameRoot
Set pISF = Nothing
Set pISI_child = Nothing
Set pIPAI = Nothing
iCount = iCount + 1
SHUpdateImageW StrPtr(sName), iIconIndex, &H2, iIconIndex
iIconIndex = Shell_GetCachedImageIndexW(lpName, iIconIndex, 0&)
lpNameRoot = 0
pidlRoot = 0
lpName = 0
sNameRoot = 0
Loop
err_out:
Debug.Print Err.Number & " , " & Err.Description
End Function