Visual Basic Common Control API Routines
SHGetFileInfo: ListView Demo 4 - Adding the Associated Icons
Last of four pages to create a ListView application to retrieve files from a specified folder.
Posted:   Sunday March 1, 1997
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch
  Related:   SHGetFileInfo: ListView Demo 1 - Obtaining the File Path
SHGetFileInfo: ListView Demo 2 - Populating the ListView
SHGetFileInfo: ListView Demo 3 - Adding Sorting Functionality
SHGetFileInfo: ListView Demo 4 - Adding the Associated Icons
SHGetFileInfo: ListView Demo 3 - Adding Sorting Functionality

This method is intended for Visual Basic 5 or Visual Basic 6 where the Common Control library used is the MSComCtl 5 version (comctl32.ocx). Because the VB6-specific mscomctl.ocx (Common Controls 6) is a complete implementation of comctl32.dll and not reliant on the version of comctl32.dll installed, this routine may not work when applied to a listview created from the VB6-specific mscomctl.ocx.

Enhanced Comctl32 functionality is only available to users with comctl32.dll version 4.70 or greater installed. This dll is typically installed with IE3.x or greater.

vbnsLVDemo4.gif (8747 bytes)By far the most complicated code yet, this page adds the code necessary to retrieve the Windows associated icon for a given file, assign it to an imagelist dynamically, and use it to display with the file in the listview. Among the features of the method detailed here is the reuse of an icon if it has already been added to the imagelist, improving both performance and resource issues.

When the demo is completed, the final app will retrieve the users selection and populate the listview with selected files from that folder, complete with associated icons, file name, file type, file size and created date.

To the project form, add the following new controls:

  • Imagelist - ImageList1
    PictureBox - pixSmall
    PictureBox - pixDummy
    Label - lbIconCount
    Label - lbItemCount

Before using the picture boxes and imagelist, a couple of preparation steps are required. Set the properties for both picture boxes to the following:

  • Appearance = 0 - Flat
    AutoSize = False
    BorderStyle = 0 - None
    ScaleMode = 1 - Twip
    Height = 240
    Width = 240
    Visible = False

If you've kept the form's ScaleMode as Twips, then 240 is equivalent to 16 pixels. Finally, set:

  • pixDummy: AutoRedraw = False
    pixSmall: AutoRedraw = True

Image lists can not be bound to an object (the ListView) if it is empty. Similarly, it can not be cleared if it is bound to a control. To circumvent these limitations, add any 16x16 icon to the imagelist as picture 1. The Key and Tag properties can be left empty.

However, because an icon is required when dynamically clearing then reassigning the imagelist, a dummy icon is needed to place into picture 1 through code. Therefore to pixDummy, assign a 16x16 icon or bitmap as well.

The icons or bitmaps used above can be any as long as they are 16x16 pixels in size, as they are actually never shown.

An imagelist cannot contain bitmaps (images) of different sizes; the size of the first bitmap assigned determines the size of all bitmaps in the imagelist. Therefore you must assign a 16x16 bitmap to the imagelist, and a 16x16 image to pixDummy for the images to display properly in the ListView. If your ListView shows the icons as stretched 32x32 icons, check the original image size again.

Align lbIconCount under the listview to the left. Set its AutoSize property to True. Align lbItemCount under the listview to the right. Set its AutoSize property to True, and its alignment to Right Justify.

With the preparation out of the way, you can begin to add the code required.

 BAS Module Code
There are no changes to the general declarations area of the project's bas module.

 Form Code
Make the following additions to the form code:

Option Explicit
In the form's general declarations, add:
Dim DOSExeIconLoaded As Boolean

In the form code, make the following bolded changes: 
Private Sub Form_Load()

    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    With Combo1
        .AddItem "All Files and Folders (*.*)"
        .AddItem "Applications (*.exe)"
        .AddItem "Device Drivers (*.drv)"
        .AddItem "Documents (*.doc)"
        .AddItem "Dynamic Link Libraries (*.dll)"
        .AddItem "Rich Text Format Documents (*.rtf)"
        .AddItem "System Files (*.sys)"
        .AddItem "Visual Basic Modules (*.bas)"
        .AddItem "Visual Basic Forms (*.frm)"
        .AddItem "Visual Basic 3 Projects (*.mak)"
        .AddItem "Visual Basic 4 Projects (*.vbp)"
        .AddItem "Postscript Printer Font Metrics (*.pfm)"
        .AddItem "Text Files (*.txt)"
        .AddItem "True Type Fonts (*.ttf)"
        .AddItem "Windows Help Files (*.hlp)"
        .AddItem "Windows Shortcuts (*.lnk)"
        .ListIndex = 0
    End With

    With ListView1
      .SortKey = 0
      .SmallIcons = ImageList1
    End With
    UpdateFrequency = 25     
    prevOrder = 0
End Sub

Add the following new code to the form:
Function HiWord(dw As Long) As Integer
    If dw And &H80000000 Then
       HiWord = (dw \ 65535) - 1
       HiWord = dw \ 65535
    End If
End Function

Private Function InitializeImageList() As Boolean

    On Local Error GoTo InitializeError
      Set ListView1.SmallIcons = Nothing
      ImageList1.ListImages.Add , "dummy", pixDummy.Picture
      Set ListView1.SmallIcons = ImageList1
      InitializeImageList = True
    Exit Function
      InitializeImageList = False
End Function

Private Function vbAddFileItemIcon(hImgSmall&) As Long

    Dim r As Long
    pixSmall.Picture = LoadPicture()
    r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, pixSmall.hDC, 0, 0, ILD_TRANSPARENT)
    pixSmall.Picture = pixSmall.Image
    vbAddFileItemIcon& = hImgSmall&
End Function

Make the following modifications to the routines 
vbGetFileList and vbAddFileItemView:
Private Sub vbAddFileItemView(WFD As WIN32_FIND_DATA)

    Dim sFileName As String
    Dim ListImgKey As String
    Dim fType As String
    sFileName = TrimNull(WFD.cFileName)
    If sFileName <> "." And sFileName <> ".." Then

      Dim r As Long
      Dim tExeType As Long
      Dim itmX As ListItem  

      Dim hImgSmall As Long
      Dim hExeType As Long
      Dim imgX As ListImage
      On Local Error GoTo AddFileItemViewError
      hImgSmall& = SHGetFileInfo(fPath & sFileName, _
                       0&, shinfo, Len(shinfo), _
                       BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
      fType$ = LCase$(TrimNull(shinfo.szTypeName))
      ListImgKey = fType
      If fType = "application" Or fType = "shortcut" Then
        If fType = "application" Then
          tExeType = SHGetFileInfo(fPath & sFileName, _
                          0&, shinfo, Len(shinfo), SHGFI_EXETYPE)
          hExeType = HiWord(tExeType)
        End If
        If hExeType > 0 Or fType = "shortcut" Then
           r = vbAddFileItemIcon(hImgSmall)
           Set imgX = ImageList1.ListImages.Add(, sFileName, pixSmall.Picture)
           ListImgKey = sFileName
           ListImgKey = "DOSExeIcon"
           If DOSExeIconLoaded = False Then
              r = vbAddFileItemIcon(hImgSmall)
              Set imgX = ImageList1.ListImages.Add(, ListImgKey, pixSmall.Picture)
              DOSExeIconLoaded = True
           End If
        End If
      End If
      Set itmX = ListView1.ListItems.Add(, , LCase$(sFileName))
      itmX.SmallIcon = ImageList1.ListImages(ListImgKey).Key
      itmX.SubItems(1) = vbGetFileSizeKBStr(WFD.nFileSizeHigh + WFD.nFileSizeLow)
      itmX.SubItems(2) = fType
      itmX.SubItems(3) = vbGetFileDate(WFD.ftCreationTime)
    End If
  Exit Sub
    If vbAddFileItemIcon(hImgSmall) Then
      Set imgX = ImageList1.ListImages.Add(, fType, pixSmall.Picture)
    End If

End Sub

Private Sub vbGetFileList()

    Dim hFile As Long
    Dim fName As String
    Dim fExt As String
    Dim counter As Integer
    Me.MousePointer = vbArrowHourglass
    fExt = vbGetComboFileSpec()
    If Len(fPath) > 0 And Len(fExt) > 0 Then
      fName$ = fPath & fExt
      DisplayName = fName
      If InitializeImageList() Then  
          hFile& = FindFirstFile(fName, WFD)
            If hFile& > 0 Then
              counter = 1
              vbAddFileItemView WFD
                While FindNextFile(hFile, WFD)
                  counter = counter + 1
                  vbAddFileItemView WFD
                    If counter = UpdateFrequency Then
                      Call UpdateWindow(ListView1.hwnd)
                      counter = 0
                    End If
            End If
          FindClose hFile
      End If   
    End If
    lbIconCount = "The ImageList for this target file type view contains " & _
                  ImageList1.ListImages.Count - 1 & IIf(ImageList1.ListImages.Count - 1 > 1, _
                  " different images.", " image.")
    lbItemCount = ListView1.ListItems.Count & " files" 
    cmdSelect(1).Enabled = False  
    DOSExeIconLoaded = False   
    Me.MousePointer = vbDefault
End Sub
Run the project, and click the Select Folder button. Browse to any folder, and hit OK. The folder selected and the file type from the combo box should be returned in the DisplayName label as a fully-qualified path and filespec. The listview should populate with all the files in the selected directory matching the selected file type, and the Windows associated icons should appear with each file.

The two labels at the bottom will detail the number of actual icons used, and the number of files listed. For executables, this generally means an icon per file. When these differ, it is probably due to the reusing of the Windows DOS icon.

By right-clicking over the listview control, you can select from the popup menu. As well, the clicking the column headers will also sort the items. Note however that the numeric sorting of the file size is inaccurate; a ListView normally calls a special routine via callbacks to sort non-alpha items. This ability to use a callback is not available in VB4; VB5 owners see
SendMessage: Controlling a ListView Sort Using Callbacks.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter