Option Explicit
Private Const MAX_PATH As Long = 260
Private Const SHGFI_DISPLAYNAME As Long = &H200
Private Const SHGFI_EXETYPE As Long = &H2000
Private Const SHGFI_SYSICONINDEX As Long = &H4000 ' System icon index
Private Const SHGFI_SHELLICONSIZE As Long = &H4
Private Const SHGFI_TYPENAME As Long = &H400
Private Const SHGFI_LARGEICON As Long = &H0 ' Large icon
Private Const SHGFI_SMALLICON As Long = &H1 ' Small icon
Private Const BASIC_SHGFI_FLAGS As Long = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME
Private Const ILD_TRANSPARENT As Long = &H1 ' Display transparent
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As Long) As Long
Private Sub Form_Load()
Dim Dr() As String
Dim i As Long
'my drives - use your own array of drives *******************
Dr = Split("C:\,D:\,E:\,H:\", ",")
With Picture1
.ScaleMode = vbPixels
.AutoRedraw = True
.Width = 240
.Height = 240 '16x16 pixels
.BorderStyle = 0
.Appearance = 0
.Visible = False 'change if desired
End With
With ListView1
.View = lvwReport
.ColumnHeaders.Add , , "Drives"
End With
'Load the imagelist. Note, you can load
' images and the LV in one loop if you
' assign a dummy 16x16 pic at design time
' Otherwise, you can't assign the ImageList
' to the LV when it has no images assigned
For i = 0 To UBound(Dr)
Picture1.Cls
RenderIcon Dr(i), Picture1.hDC, 0, 0, False
ImageList1.ListImages.Add , Dr(i), Picture1.Image
Next
ListView1.SmallIcons = ImageList1
For i = 0 To UBound(Dr)
With ListView1.ListItems.Add
.Text = Dr(i)
.SmallIcon = Dr(i)
End With
Next
End Sub
Public Sub RenderIcon(ByVal Path As String, ByVal PicHdc As Long, ByVal X As Long, ByVal Y As Long, Optional ByVal LargeIcon As Boolean = False)
Dim hImg As Long, Flags As Long
Dim SFO As SHFILEINFO
Flags = BASIC_SHGFI_FLAGS
If LargeIcon Then
Flags = Flags Or SHGFI_LARGEICON
Else
Flags = Flags Or SHGFI_SMALLICON
End If
hImg = SHGetFileInfo(Path, ByVal 0&, SFO, Len(SFO), Flags)
ImageList_Draw hImg, SFO.iIcon, PicHdc, X, Y, ILD_TRANSPARENT
End Sub