Results 1 to 3 of 3

Thread: [VB6, Vista+] Direct access to the system-wide image thumbnail cache

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,647

    [VB6, Vista+] Direct access to the system-wide image thumbnail cache


    While in general you want to use IShellItemImageFactory to get these thumbnails, as that will also return icons, if you're interested in more control or better performance, you can use IThumbnailCache and the Windows supplied implementation LocalThumbnailCache for direct access to the main system thumbnail cache.

    There's a large number of additional options, and even more still if you're using Windows 8 or higher. You can choose whether to extract if not in the cache, only retrieve it if cached already, or extract it again to update the cached version. While not shown in the picture above, these thumbnails do properly render transparency.

    Main routine (see full project for declares, module-level vars, etc):
    Code:
    Private Sub Command1_Click()
    Dim fod As New FileOpenDialog
    Dim kfPics As IShellItem
    Dim tSpec() As COMDLG_FILTERSPEC
    Dim pBitmap As ISharedBitmap
    Dim hBmp As Long
    Dim lFlag As WTS_CACHEFLAGS
    Dim btID As WTS_THUMBNAILID
    Dim tSZ As SIZE
    Dim lOpt As WTS_FLAGS
    On Error GoTo e0
    
    ReDim tSpec(1)
    
    tSpec(0).pszName = "Image Files"
    tSpec(0).pszSpec = "*.gif;*.jpg;*.png;*.ico;*.bmp"
    tSpec(1).pszName = "All Files"
    tSpec(1).pszSpec = "*.*"
    
    fod.SetClientGuid GUID_ThisProject
    fod.SetTitle "Choose an image"
    fod.SetOkButtonLabel "Show Thumbnail"
    fod.SetOptions FOS_DONTADDTORECENT
    fod.SetDefaultFolder kfPics
    fod.SetFileTypes 2&, VarPtr(tSpec(0).pszName)
    fod.Show Me.hWnd
    
    On Error Resume Next
    fod.GetResult psiFile
    On Error GoTo e0
    
    If (psiFile Is Nothing) = False Then
        If (pCache Is Nothing) Then
            Set pCache = New LocalThumbnailCache
        End If
        'Note: Many WTS options are Win8+ only. Here we're only demonstrating basic ones that are Win7+
        If Option1(0).Value = True Then lOpt = WTS_EXTRACT Or WTS_SCALETOREQUESTEDSIZE
        If Option1(1).Value = True Then lOpt = WTS_INCACHEONLY Or WTS_SCALETOREQUESTEDSIZE
        If Option1(2).Value = True Then lOpt = WTS_FORCEEXTRACTION Or WTS_SCALETOREQUESTEDSIZE
        If Check1.Value = vbChecked Then
            If (Option1(0).Value = True) Or (Option1(2).Value = True) Then lOpt = lOpt Or WTS_EXTRACTDONOTCACHE
        End If
        pCache.GetThumbnail psiFile, cxThumb, lOpt, pBitmap, lFlag, btID
        If (pBitmap Is Nothing) = False Then
            pBitmap.GetSize tSZ
            Debug.Print "Got bitmap obj, cx=" & tSZ.CX & ",flag=0x" & Hex$(lFlag)
            PrintThumbID btID
            pBitmap.GetSharedBitmap hBmp
            Debug.Print "hBITMAP=" & hBmp
            Picture1.Cls
            hBitmapToPictureBox Picture1, hBmp
            pBitmap.Detach hBmp
            DeleteObject hBmp
        Else
            Debug.Print "Failed to get bitmap obj, flag=0x" & Hex$(lFlag)
        End If
    Else
        Debug.Print "No file selected."
    End If
    
    Exit Sub
    
    e0:
        Debug.Print "GetThumb.Error->" & Err.Description & " (0x" & Hex$(Err.Number) & ")"
    End Sub
    Requirements
    -Windows Vista or higher. Some options in demo project are Windows 7 and higher. The interface itself has many options only available on Windows 8 and higher, although none are used in the demo.
    -oleexp.tlb version 4.0 or higher. Only needed for the IDE, doesn't need to be redistributed with your exe.

    Notes
    Thumbnails are looked up by providing an IShellItem representing the file. In the sample, this is super easy as that's what's returned from the FileOpenDialog. But without that, you can get that reference from any number of methods, including SHGetItemFromParsingName:
    Code:
    Public Declare Function SHCreateItemFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, riid As UUID, ppv As Any) As Long
    
    Call SHCreateItemFromParsingName(StrPtr(pathtofile), ByVal 0&, IID_IShellItem, psi)
    Or from a pidl,
    Code:
    Public Declare Function SHCreateItemFromIDList Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any) As Long
    Alternative Access to Thumbnail
    Closely related, there's a very simple way to get the thumbnail of an image file (and only image file; this won't return a normal icon either) represented by an IShellItem:

    Code:
    Dim hbmTP As Long
    Dim pTP As IThumbnailProvider
    Dim psiImg As IShellItem
    
    Call SHCreateItemFromParsingName(StrPtr("C:\folder\MyImage.jpg"), ByVal 0&, IID_IShellItem, psiImg)
    psiImg.BindToHandler 0&, BHID_ThumbnailHandler, IID_IThumbnailProvider, pTP
    If (pTP Is Nothing) = False Then
        pTP.GetThumbnail 128&, hbmTP, WTSAT_ARGB 'where 128 is the desired size. 16-256, maybe 512 work the best
        Debug.Print "hbm=" & hbmTP
        hBitmapToPictureBox Picture1, hbmTP
    Else
        Debug.Print "no ptp"
    End If
    Where the hBitmapToPictureBox is the same as the demo project. This code snippet also makes use of mIID.bas from the oleexp download.
    This method has the bonus of an option controlling transparency.
    Attached Files Attached Files
    Last edited by fafalone; Nov 29th, 2016 at 07:30 PM.

  2. #2
    New Member
    Join Date
    May 2018
    Posts
    1

    Question Re: [VB6, Vista+] Direct access to the system-wide image thumbnail cache

    Hi Fafalone,
    Thanks for the great work in this project. I am getting a no file selected message with the following code. Can you please offer some help? The image file definitely exists on disk.

    Code:
    Private Declare Function SHCreateItemFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, riid As UUID, ppv As Any) As Long
    Private psiFile As IShellItem
    Private IID_IShellItem As UUID
    
    
    
    Call SHCreateItemFromParsingName(StrPtr("C:\Users\n358924\Documents\2018-03-23 15.57.44 Ullswater.JPG"), ByVal 0&, IID_IShellItem, psiFile)
    
    
    If (psiFile Is Nothing) = False Then
        If (pCache Is Nothing) Then
            Set pCache = New LocalThumbnailCache
        End If
        'Note: Many WTS options are Win8+ only. Here we're only demonstrating basic ones that are Win7+
        If Option1(0).Value = True Then lOpt = WTS_EXTRACT Or WTS_SCALETOREQUESTEDSIZE
        If Option1(1).Value = True Then lOpt = WTS_INCACHEONLY Or WTS_SCALETOREQUESTEDSIZE
        If Option1(2).Value = True Then lOpt = WTS_FORCEEXTRACTION Or WTS_SCALETOREQUESTEDSIZE
        If Check1.Value = vbChecked Then
            If (Option1(0).Value = True) Or (Option1(2).Value = True) Then lOpt = lOpt Or WTS_EXTRACTDONOTCACHE
        End If
        pCache.GetThumbnail psiFile, cxThumb, lOpt, pBitmap, lFlag, btID
        If (pBitmap Is Nothing) = False Then
            pBitmap.GetSize tSZ
            Debug.Print "Got bitmap obj, cx=" & tSZ.CX & ",flag=0x" & Hex$(lFlag)
            PrintThumbID btID
            pBitmap.GetSharedBitmap hBmp
            Debug.Print "hBITMAP=" & hBmp
            Picture1.Cls
            hBitmapToPictureBox Picture1, hBmp
            pBitmap.Detach hBmp
            DeleteObject hBmp
        Else
            Debug.Print "Failed to get bitmap obj, flag=0x" & Hex$(lFlag)
        End If
    Else
        Debug.Print "No file selected."
        End
    End If

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,647

    Re: [VB6, Vista+] Direct access to the system-wide image thumbnail cache

    IID_IShellItem is blank. If you're not using mIID (and if you are, simply remove the Dim for it), you need to fill it in; instead of the Dim IID_IShellItem.. use
    Code:
    Private Function IID_IShellItem() As UUID
    Static iid As UUID
    If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H43826D1E, CInt(&HE718), CInt(&H42EE), &HBC, &H55, &HA1, &HE2, &H61, &HC3, &H7B, &HFE)
    IID_IShellItem = iid
    End Function
    Private Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
      With Name
        .Data1 = L
        .Data2 = w1
        .Data3 = w2
        .Data4(0) = B0
        .Data4(1) = b1
        .Data4(2) = b2
        .Data4(3) = B3
        .Data4(4) = b4
        .Data4(5) = b5
        .Data4(6) = b6
        .Data4(7) = b7
      End With
    End Sub
    or use one of the other methods of filling in a GUID.

Tags for this Thread

Posting Permissions

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



Click Here to Expand Forum to Full Width