Visual Basic Codes
Visual Basic > Graphics Games Programming sample source codes

Extracting the icon associate with a file and displaying in a listview

Extracting the icon associate with a file and displaying in a listview

The following code demonstrates how to display files and their associated icons in the same way "Windows Explorer" does. The code in the "Test" routine scans all the files in your C:\ and displays them along with their associated icons in a listview.


Private Const MAX_PATH = 260

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type PICTDESC
    cbSize As Long
    picType As Long
    hImage As Long
    Data1 As Long
    Data2 As Long
End Type

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 OleCreatePictureIndirect Lib "olepro32.dll" (pPictDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, ppvObj As StdPicture) As Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long




'Purpose     :  Retrieves the default associated icon from a file
'Inputs      :  sFileName                           The full path and name of the file to retrieve the icon of.
'Outputs     :  Returns the icon


Function FileExtractIcon(sFileName As String) As StdPicture
    Dim tPic As PICTDESC
    Dim tIDispatch As GUID
    Dim oPic As StdPicture
    Dim hIcon As Long
    Dim tFileInfo As SHFILEINFO
    Const SHGFI_ICON = &H100, SHGFI_DISPLAYNAME = &H200
    Const SHGFI_TYPENAME = &H400, SHGFI_SMALLICON = &H1
    'FYI, file attribute bits
    Const FILE_ATTRIBUTE_READONLY = &H1, FILE_ATTRIBUTE_HIDDEN = &H2
    Const FILE_ATTRIBUTE_SYSTEM = &H4, FILE_ATTRIBUTE_DIRECTORY = &H10
    Const FILE_ATTRIBUTE_ARCHIVE = &H20, FILE_ATTRIBUTE_NORMAL = &H80
    Const FILE_ATTRIBUTE_TEMPORARY = &H100
    
    
    On Error Resume Next
    'Extract File information
    Call SHGetFileInfo(sFileName, 0, tFileInfo, Len(tFileInfo), SHGFI_DISPLAYNAME Or SHGFI_TYPENAME Or SHGFI_SMALLICON Or SHGFI_ICON)
    'Get the handle to the files icon
    hIcon = tFileInfo.hIcon
    
    'Initialise type
    With tPic
        .cbSize = Len(tPic)
        .picType = 3        'vbPicTypeIcon
        .hImage = hIcon
    End With
    
    'Fill IDispatch Interface ID,{00020400-0000-0000-C000-000000046}
    With tIDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    
    'Get Icon
    Call OleCreatePictureIndirect(tPic, tIDispatch, 0, oPic)
    'Return Icon
    Set FileExtractIcon = oPic
    
    On Error GoTo 0
End Function


'Purpose     :  Populates a listview with the files in a specified directory
'Inputs      :  sPath                   The path to the files
'               lvFiles                 The listview to populate
'               imIcons                 An image list to store the icons
'               [sFileFilter]           A file filter string
'Outputs     :  Returns the icon
'Notes       :  eg Call RefreshFiles("C:\", lvFiles, imlFileIcons,"*")


Sub RefreshFiles(ByVal sPath As String, lvFiles As ListView, imIcons As ImageList, Optional sFileFilter As String = "*")
    Dim oFileIcon As StdPicture, sFileName As String, sFileType As String
    Dim bAddedImageList As Boolean, lThisColHeader As Long, lWidth As Long
    
    On Error Resume Next
    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    
    sFileName = Dir$(sPath & sFileFilter)
    lvFiles.View = lvwReport
    lWidth = lvFiles.Width / 10
    
    For lThisColHeader = lvFiles.ColumnHeaders.Count To 3
        Select Case lThisColHeader
        Case 1
            lvFiles.ColumnHeaders.Add , , "File Name", lWidth * 4
        Case 2
            lvFiles.ColumnHeaders.Add , , "File Size", lWidth * 3
        Case 3
            lvFiles.ColumnHeaders.Add , , "Last Modified", lWidth * 3
        End Select
    Next

    lvFiles.ListItems.Clear
    
    Do While Len(sFileName)
        sFileType = Right$(sFileName, 3)
        
        If imIcons.ListImages(sFileType).Picture Is Nothing Then
            'Find icon associated with file
            Set oFileIcon = FileExtractIcon(sPath & sFileName)
            If oFileIcon Is Nothing = False Then
                'Add to icon image list
                imIcons.ListImages.Add , sFileType, oFileIcon
                If bAddedImageList = False Then
                    'Initialise listview smallicons
                    lvFiles.SmallIcons = imlFileIcons
                    bAddedImageList = True
                End If
            End If
        End If

        'Add item to listview
        With lvFiles.ListItems.Add(, , sFileName, , sFileType)
            .SubItems(1) = Format(FileLen(sPath & sFileName) / 1024, "#,##0") & "KB"
            .SubItems(2) = Format(FileDateTime(sPath & sFileName), "dd/mmm/yyyy hh:mm")
        End With
        sFileName = Dir$
    Loop
End Sub