Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

vb.net translation (ishellitem)

Status
Not open for further replies.

hambakahle

Programmer
Nov 5, 2014
8
0
0
US
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.

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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top