Visual Basic Icon Routines

SHGetFileInfo: Extracting a 16x16 Associated Icon
     
Posted:   Friday December 27, 1996
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch, Don Bradner
     

Related:  

SHGetFileInfo: Extracting 16x16 and 32x32 Associated Icons
SHGetFileInfo: Extracting Associated Icons for a StatusBar
     
 Prerequisites
None.

vbnsiconxtract16.gif (1655 bytes)VB4-32/VB5 code to retrieve the small (16x16) system icon associated with a given application using SHGetFileInfo. If the application does not have an icon associated with it, the default Windows 'unknown' icon will be returned.

Compare this to ExtractIcon API techniques, which will return only the 32x32 icon.

ImageList_Draw routine adapted from code provided by Don Bradner.
 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const MAX_PATH As Long = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 'system icon index
Public Const SHGFI_LARGEICON = &H0 'large icon
Public Const SHGFI_SMALLICON = &H1 'small icon
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const ILD_TRANSPARENT = &H1 'display transparent
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or _
                                 SHGFI_SHELLICONSIZE Or _
                                 SHGFI_SYSICONINDEX Or _
                                 SHGFI_DISPLAYNAME Or _
                                 SHGFI_EXETYPE

Public Type SHFILEINFO
   hIcon As Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

Public Declare Function SHGetFileInfo Lib "shell32" _
   Alias "SHGetFileInfoA" _
   (ByVal pszPath As String, _ 
    ByVal dwFileAttributes As Long, _ 
    psfi As SHFILEINFO, _ 
    ByVal cbSizeFileInfo As Long, _ 
    ByVal uFlags As Long) As Long

Public Declare Function ImageList_Draw Lib "comctl32" _
   (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

Public shinfo As SHFILEINFO
 Form Code
On a form place two command buttons (Command1 & Command2), and a picturebox (pixSmall). Assure both the form and picturebox scale modes are 1 - Twips.

Set the properties of the picturebox to:

  • Appearance = 0 (flat)
  • AutoRedraw = True
  • AutoResize = False
  • BorderStyle = 0 (none)
  • Height = 240 twips
  • Width = 240 twips

This should result in both the ScaleHeight and ScaleWidth of the picturebox being 240 twips (or 16 pixels). Add the following code to the form:


Option Explicit

Private Sub Form_Load()
   
  'centre the form on the screen   
   Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

End Sub 


Private Sub Command2_Click()

   Unload Me

End Sub 


Private Sub Command1_Click()
   
  'working variables...
   Dim hImgSmall as Long   'the handle to the system image list
   Dim fName As String     'the file name to get icon from
   Dim fnFilter As String  'the file name filter   
   Dim r As Long
   
  'a little error handling to trap a cancel   
   On Local Error GoTo Command1ErrorHandler
   
  'get the file from the user   
   fnFilter$ = "All Files (*.*)|*.*|"
   fnFilter$ = fnFilter$ & "Applications (*.exe)|*.exe|"
   fnFilter$ = fnFilter$ & "Windows Bitmap (*.bmp)|*.bmp|"
   fnFilter$ = fnFilter$ & "Icon Files (*.ico)|*.ico"

   CommonDlg1.CancelError = True
   CommonDlg1.Filter = fnFilter$
   CommonDlg1.ShowOpen

   fName = CommonDlg1.FileName
   
  'get the system icon associated with that file   
   hImgSmall& = SHGetFileInfo(fName, 0&, _
                              shinfo, Len(shinfo), _
                              BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
   
  'set a picture box to receive the small icon
  'its size must be 16x16 pixels (240x240 twips), 
  'with no 3d or border!  
  'clear any existing image   
   pixSmall.Picture = LoadPicture()
   pixSmall.AutoRedraw = True
   
  'draw the associated icon into the picturebox    
   Call ImageList_Draw(hImgSmall&, shinfo.iIcon, _
                       pixSmall.hDC, 0, 0, ILD_TRANSPARENT) 
  
  'realize the image by assigning its image property 
  '(where the icon was drawn) to the actual picture property 
   pixSmall.Picture = pixSmall.Image

  'Uncomment out the following code to save
  'the image to the current path. Note that 
  'the background colour of the icon saved
  'will be the background colour of the 
  'pixSmall control.  
  'SavePicture pixSmall, "test.bmp"

Exit Sub

Command1ErrorHandler:
Exit Sub

End Sub
 Comments
Run the project, and select any file. On closing the common dialog, the icon associated with that file (or windows default Unknown icon) will be displayed, depending on whether that selected file has a Registry association or not.

The SHGetFileInfo API will return the registered icon for a given application or file, similar to that displayed in explorer.

Don't confuse the ImageList_Draw API with the VB ImageList control. The former is the API used to draw an image to a control; the latter is the control itself. It is not necessary to have an imagelist control in a project to utilize the ImageList_Draw API, as its destination can be any control with an exposed hDC.

 
 

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