Attribute VB_Name = "modListView"
Option Explicit
DefLng A-N, P-Z
DefBool O
'Icon Sizes in pixels
Private Const LARGE_ICON As Integer = 32
Private Const SMALL_ICON As Integer = 16
Private Const MAX_PATH = 260
Private Const ILD_TRANSPARENT = &H1 'Display transparent
'ShellInfo Flags
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000 'System icon index
Private Const SHGFI_LARGEICON = &H0 'Large icon
Private Const SHGFI_SMALLICON = &H1 'Small icon
Private Const SHGFI_SHELLICONSIZE = &H4
Private Const SHGFI_TYPENAME = &H400
Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Private Type SHFILEINFO 'As required by ShInfo
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
'----------------------------------------------------------
'Functions & Procedures
'----------------------------------------------------------
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&, ByVal i&, ByVal hDCDest&, ByVal X&, ByVal Y&, ByVal flags&) As Long
'----------------------------------------------------------
'Private variables
'----------------------------------------------------------
Private ShInfo As SHFILEINFO
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'---------------------------------------------------------------------
'Extract an individual icon
'---------------------------------------------------------------------
Public Function GetFileIcon(tmpFileName As String, Index As Long, tmpiml16 As imageList, tmpiml32 As imageList, tmpPic16 As PictureBox, tmpPic32 As PictureBox) As Long
Dim hLIcon As Long, hSIcon As Long 'Large & Small Icons
Dim imgObj As ListImage 'Single bmp in imagelist.listimages collection
Dim tmpResult As Long
'Get a handle to the small icon
hSIcon = SHGetFileInfo(tmpFileName, 0&, ShInfo, Len(ShInfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
'Get a handle to the large icon
hLIcon = SHGetFileInfo(tmpFileName, 0&, ShInfo, Len(ShInfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
'If the handle(s) exists, load it into the picture box(es)
If hLIcon <> 0 Then
'Large Icon
With tmpPic32
Set .Picture = LoadPicture("")
.AutoRedraw = True
tmpResult = ImageList_Draw(hLIcon, ShInfo.iIcon, tmpPic32.hDC, 0, 0, ILD_TRANSPARENT)
.Refresh
End With
'Small Icon
With tmpPic16
Set .Picture = LoadPicture("")
.AutoRedraw = True
tmpResult = ImageList_Draw(hSIcon, ShInfo.iIcon, tmpPic16.hDC, 0, 0, ILD_TRANSPARENT)
.Refresh
End With
Set imgObj = tmpiml32.ListImages.Add(Index, , tmpPic32.Image)
Set imgObj = tmpiml16.ListImages.Add(Index, , tmpPic16.Image)
End If
End Function
'-----------------------------------------
'Show the icons in the Listview
'-----------------------------------------
Public Sub ShowListviewIcons(tmpListView As ListView, tmpiml16 As imageList, tmpiml32 As imageList)
Dim Item As ListItem
On Error Resume Next
With tmpListView
.Icons = tmpiml32 'Large
.SmallIcons = tmpiml16 'Small
For Each Item In .ListItems
Item.Icon = Item.Index
Item.SmallIcon = Item.Index
Next
End With
End Sub
