dcsimg
Results 1 to 1 of 1

Thread: [VB6] Code Snippet: Get file overlay (e.g. shortcut arrow), inc. customs like DropBox

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,341

    [VB6] Code Snippet: Get file overlay (e.g. shortcut arrow), inc. customs like DropBox

    Everyone is familiar with the shortcut arrow-- this is an example of an overlay icon, a status indicator placed on top of another icon. Most existing VB file browser examples handle showing these by checking the attributes to see if it's a link or shared. But there's other icons- several more placed by Windows indicating things like offline files, security locks, permission shields, as well as custom ones- one of the most popular is DropBox. So if you want your app to display these as well, you need to look beyond file attributes to the IShellIconOverlay interface.

    Requirements
    -Windows XP or higher
    -oleexp v4.0 or higher
    -oleexp addon mIID.bas added (included in oleexp download)

    Usage
    The GetOverlayIconIndex returns a 1-based index number, so you should determine a valid choice by checking if >0. Assigning an invalid choice (<1 or >15) may result in the main icon not being rendered at all.
    If you're using a control such as a ListView or TreeView and are not already assigning overlays, they're typically added like this:
    lvi.StateMask = LVIS_OVERLAYMASK
    lvi.State = INDEXTOOVERLAYMASK(overlayindex)

    where lvi is an LVITEM and this is followed with LVM_INSERTITEM or LVM_SETITEM. TreeViews are nearly identical. Do not set the overlay if there is none (the valid results mentioned above... do not set the statemask/state if the index is 0 or -1).

    The Code
    Code:
    Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
    Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long)
    Public Declare Function SHGetDesktopFolder Lib "shell32" (ppshf As IShellFolder) As Long
    
    Public Function GetOverlayIconIndex(sPath As String, sFile As String) As Long
    'Returns the overlay index for a file icons (like the shortcut arrow)
    Dim iDL As Long
    Dim psf As IShellFolder
    Dim povr As IShellIconOverlay
    Dim pUnk As oleexp.IUnknown
    Dim pcid As Long, pche As Long, lAt As Long
    
    iDL = ILCreateFromPathW(StrPtr(sPath))
    If iDL Then
        Set psf = GetIShellFolder(isfDesktop, iDL)
        psf.ParseDisplayName 0&, 0&, StrPtr(sFile), pche, pcid, 0&
        If (psf Is Nothing) = False Then
            Set pUnk = psf
            pUnk.QueryInterface IID_IShellIconOverlay, povr
            If (povr Is Nothing) Then
                Debug.Print "GetOverlayIconIndex failed to get ishelliconoverlay " & sFile
            Else
                If pcid Then
                    Dim pio As Long
                    On Error Resume Next 'CRITICAL: files with no overlay return -1 AND raise a runtime error
                    povr.GetOverlayIndex pcid, VarPtr(pio)
                    GetOverlayIconIndex = pio
                    On Error GoTo 0
                Else
                    Debug.Print sFile & "::GetOverlayIconIndex no child pidl"
                End If
            End If
        Else
            Debug.Print "GetOverlayIconIndex::no IShellFolder"
        End If
        Call CoTaskMemFree(pcid)
        Call CoTaskMemFree(iDL)
    Else
        Debug.Print "GetOverlayIconIndex::no pidl"
    End If
    
    End Function
    
    'Generic support functions you may already have if working with IShellFolder
    Public Function GetIShellFolder(isfParent As IShellFolder, pidlRel As Long) As IShellFolder
      Dim isf As IShellFolder
      On Error GoTo out
    
      Call isfParent.BindToObject(pidlRel, 0, IID_IShellFolder, isf)
    
    out:
      If Err Or (isf Is Nothing) Then
        Set GetIShellFolder = isfDesktop
      Else
        Set GetIShellFolder = isf
      End If
    
    End Function
    Public Function isfDesktop() As IShellFolder
      Static isf As IShellFolder
      If (isf Is Nothing) Then Call SHGetDesktopFolder(isf)
      Set isfDesktop = isf
    End Function
    Notes
    -If a file doesn't have an overlay, the COM interface throws a runtime error (0x80004005 automation error unspecified). The code snippet above uses On Error Resume Next to suppress this, but if you have 'Break On All Errors' enabled, it will come up.

    -The overlay index returned includes the standard shortcut and share overlays; you can eliminate code checking for them separately.

    -Here's the INDEXTOOVERLAYMASK function mentioned earlier if you need it:
    Code:
    Public Function INDEXTOOVERLAYMASK(iOverlay As Long) As Long
      '   INDEXTOOVERLAYMASK(i)   ((i) << 8)
      INDEXTOOVERLAYMASK = iOverlay * (2 ^ 8)
    End Function
    UPDATE- Code updated to free child pidl as well; not freeing it causes memory leakage. Call CoTaskMemFree(pcid)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width