KnowledgeBase Archive

An Archive of Early Microsoft KnowledgeBase Articles

View on GitHub

Q241590: HOWTO: Use SHFileInfo to Get the Associated Icon for Files

Article: Q241590
Product(s): Microsoft Visual Basic for Windows
Version(s): WINDOWS:5.0,6.0
Operating System(s): 
Keyword(s): kbAPI kbSDKWin32 kbShellGrp kbVBp kbVBp500 kbVBp600 kbGrpDSVB kbDSupport
Last Modified: 11-JAN-2001

-------------------------------------------------------------------------------
The information in this article applies to:

- Microsoft Visual Basic Learning Edition for Windows, versions 5.0, 6.0 
- Microsoft Visual Basic Professional Edition for Windows, versions 5.0, 6.0 
- Microsoft Visual Basic Enterprise Edition for Windows, versions 5.0, 6.0 
-------------------------------------------------------------------------------

SUMMARY
=======

Whenever you want to drag and drop files from the Microsoft Windows Explorer and
want to display the icon associated with the files (for example, in a listview),
there is no built-in way to get the icon that is associated with a file.
However, you can accomplish this by using the Windows API.

MORE INFORMATION
================

1. Create a new Visual Basic Standard EXE Project. Form1 is created by default.

2. From the Project menu, select Components, select Microsoft Rich Text Box
  Control and Microsoft Windows Common Controls, and click OK.

3. Add a ListView control to Form1, and name it "lvFileList" (without the
  quotation marks).

4. Add a RichTextbox control to Form1, and name it "rtBox" (without the
  quotation marks).

5. Add two PictureBoxes, and name them picInvisiblePictureBox and
  picDummyPictureBox.

6. Add an ImageList control, and name it ilImages.

7. Paste the following code into the code window of Form1:

  Option Explicit

  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 ILD_TRANSPARENT = &H1         ' display transparent
  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 Const MAX_PATH = 260

  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 ImageList_Draw Lib "comctl32.dll" _
     (ByVal himl As Long, _
      ByVal i As Long, _
      ByVal hDCDest As Long, _
      ByVal x As Long, _
      ByVal y As Long, _
      ByVal flags As Long) As Long

  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 Sub Form_Load()
      ' Set the properties of items on the form
      With picDummyPictureBox
          .AutoRedraw = True
          .AutoSize = True
          .Height = 495
          .Width = 495
          .Appearance = 0 'flat
          .Visible = False
      End With
      
      With picInvisiblePictureBox
          .AutoRedraw = True
          .AutoSize = True
          .Height = 495
          .Width = 495
          .Appearance = 0 'flat
          .Visible = False
      End With
      
      rtBox.OLEDropMode = rtfOLEDropManual
      
      ' It doesn't matter what icon you use here. Adjust this path to point 
      ' to an icon on your system. The important thing is to make sure the 
      ' size is correct.
      picDummyPictureBox.Picture = LoadPicture("C:\Program Files\Microsoft Visual Studio\Common\Graphics\Icons\Flags\flgusa01.ico")
      
      ' Put the icon onto the list box to initialize it
      Set lvFileList.SmallIcons = Nothing
      ilImages.ListImages.Clear
      ilImages.ListImages.Add , "dummy", picDummyPictureBox.Picture
      Set lvFileList.Icons = ilImages      
  End Sub

  Private Sub rtBox_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

      Dim nCounter As Integer
      Dim lBoundary As Long
      
      ' Take the files that are dropped, and put them into the listview.
      For nCounter = 1 To Data.Files.Count
          StickIconOntoListView Data.Files(nCounter)
      Next nCounter
  End Sub

  Private Sub StickIconOntoListView(strFile As String)

      Dim hImgLarge As Long
      Dim hFile As Long
      Dim strFileType As String
      Dim strListImageKey As String
      Dim imgX As ListImage
      Dim hEXEType As Long
      Dim tEXEType As Long
      Dim lRet As Long
      Dim itmX As ListItem
      Dim shinfo As SHFILEINFO
      
      ' Get the icon data from the file
      hImgLarge = SHGetFileInfo(strFile, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
        
      ' lcase the filename so it looks nice in the listview.
      ' Remove the nulls at the end of the string
      strFileType = LCase(StripNulls(shinfo.szTypeName))
        
      If hImgLarge > 0 Then
          ' Pull the icon out of the file
          lRet = vbAddFileItemIcon(hImgLarge, shinfo)
          
          ' once you get the icon out of the file, you need to add it to the 
          ' image list so that we can stick it into the listview.

          ' NOTE: If the file dropped in is an EXE that has an icon in it 
          ' already, this won't work. You can look at the strFileType 
          ' variable here and handle that differently.
          ' This also raises an error if you try to add the same file twice.
          Set imgX = ilImages.ListImages.Add(, strFile, _
             picInvisiblePictureBox.Picture)
          strListImageKey = strFile
      Else
          ' Error!
      End If
       
      ' Add the icon to the list image
      Set itmX = lvFileList.ListItems.Add(, , LCase(strFile))
      itmX.Icon = ilImages.ListImages(strListImageKey).Key
      
      Set itmX = Nothing
  End Sub<BR/>

  Private Function vbAddFileItemIcon(hImage As Long, sInfo As SHFILEINFO) As Long

      Dim lRet As Long
        
      ' clear the PictureBox
      picInvisiblePictureBox.Picture = LoadPicture()
      
      ' put the icon onto the PictureBox
      lRet = ImageList_Draw(hImage, sInfo.iIcon, _
         picInvisiblePictureBox.hDC, 0, 0, ILD_TRANSPARENT)
      
      picInvisiblePictureBox.Picture = picInvisiblePictureBox.Image
      picInvisiblePictureBox.Height = 495
      picInvisiblePictureBox.Width = 495
      
      vbAddFileItemIcon = lRet
  End Function

  Private Function StripNulls(strItem As String) As String

      Dim nPos As Integer
      
      nPos = InStr(strItem, Chr$(0))
      If nPos Then
          strItem = Left$(strItem, nPos - 1)
      End If
      StripNulls = strItem
  End Function

8. Run the project. Using Windows Explorer, drag some files and drop them onto
  the RichTextbox. They should show up in the ListView control.

Additional query words:

======================================================================
Keywords          : kbAPI kbSDKWin32 kbShellGrp kbVBp kbVBp500 kbVBp600 kbGrpDSVB kbDSupport 
Technology        : kbVBSearch kbAudDeveloper kbZNotKeyword6 kbZNotKeyword2 kbVB500Search kbVB600Search kbVBA500 kbVBA600 kbVB500 kbVB600
Version           : WINDOWS:5.0,6.0
Issue type        : kbhowto

=============================================================================

THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY.

Copyright Microsoft Corporation 1986-2002.