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-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)Code:
Public Declare Function SHCreateItemFromIDList Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any) As LongClosely 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 IfThis method has the bonus of an option controlling transparency.