hambakahle
Programmer
The following vb.net code block serves to retrieve Windows thumbnails. I like some opinions as to whether it will translate to VBA or whether a better route will be to amend to a vb.net class and create a .dll ?
Thanks much.
Thanks much.
Code:
Public Enum SIIGBF
'SIIGBF_RESIZETOFIT = 0
SIIGBF_BIGGERSIZEOK = 1
'SIIGBF_MEMORYONLY = 2
'SIIGBF_ICONONLY = 4
SIIGBF_THUMBNAILONLY = 8
SIIGBF_INCACHEONLY = 16
End Enum
Public Enum SIGDN As UInteger
NORMALDISPLAY = 0
PARENTRELATIVEPARSING = &H80018001UI
PARENTRELATIVEFORADDRESSBAR = &H8001C001UI
DESKTOPABSOLUTEPARSING = &H80028000UI
PARENTRELATIVEEDITING = &H80031001UI
DESKTOPABSOLUTEEDITING = &H8004C000UI
FILESYSPATH = &H80058000UI
URL = &H80068000UI
End Enum
<ComImportAttribute(), GuidAttribute("bcc18b79-ba16-442f-80c4-8a59c30c463b"), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
Private Interface IShellItemImageFactory
Sub GetImage(ByVal size As IMAGESIZE, ByVal flags As SIIGBF, ByRef phbm As IntPtr)
End Interface
<ComImport()> <Guid("43826d1e-e718-42ee-bc55-a1e261c37bfe")> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Private Interface IShellItem
Sub BindToHandler(ByVal pbc As IntPtr, <MarshalAs(UnmanagedType.LPStruct)> ByVal bhid As Guid, _
<MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, ByRef ppv As IntPtr)
Sub GetParent(ByRef ppsi As IShellItem)
Sub GetDisplayName(ByVal sigdnName As SIGDN, ByRef ppszName As IntPtr)
Sub GetAttributes(ByVal sfgaoMask As UInt32, ByRef psfgaoAttribs As UInt32)
Sub Compare(ByVal psi As IShellItem, ByVal hint As UInt32, ByRef piOrder As Integer)
End Interface
<DllImport("shell32.dll", CharSet:=CharSet.Unicode, PreserveSig:=False)> _
Private Sub SHCreateItemFromParsingName(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszPath As String, ByVal pbc As IntPtr, _
<MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <MarshalAs(UnmanagedType.Interface, _
IidParameterIndex:=2)> ByRef ppv As IShellItem)
End Sub
'Declare Sub SHCreateItemFromParsingName Lib "shell32.dll" (<MarshalAs(UnmanagedType.LPWStr)> ByVal pszPath As String, _
' ByVal pbc As IntPtr, <MarshalAs(UnmanagedType.LPStruct)> _
' ByVal riid As Guid, <MarshalAs(UnmanagedType.Interface, IidParameterIndex:=2)> ByRef ppv As IShellItem)
<StructLayout(LayoutKind.Sequential)> _
Public Structure IMAGESIZE
Public cx As Integer
Public cy As Integer
Public Sub New(ByVal cx As Integer, ByVal cy As Integer)
Me.cx = cx
Me.cy = cy
End Sub
End Structure
Public Function GetShellIcon(ByVal ImagePath As String, Optional ByVal ThumbWidth As Integer = 100, _
Optional ByVal ThumbHeight As Integer = 100) As Image
Dim mySIIGBF As SIIGBF
Dim ppsi As IShellItem = Nothing
Dim hbitmap As IntPtr = IntPtr.Zero
Dim uuid As New Guid("43826d1e-e718-42ee-bc55-a1e261c37bfe")
Dim bmp As Image 'bitmap
SHCreateItemFromParsingName(ImagePath, IntPtr.Zero, uuid, ppsi)
DirectCast(ppsi, IShellItemImageFactory).GetImage(New IMAGESIZE(ThumbWidth, ThumbHeight), mySIIGBF, hbitmap)
bmp = System.Drawing.Image.FromHbitmap(hbitmap)
Return bmp
hbitmap = IntPtr.Zero
End Function