在列表视图中显示文件夹图标

时间:2016-01-29 03:58:48

标签: .net vb.net shell listview icons

我设法使用shell32提取显示列表视图中的文件图标,但是当使用文件夹时,图标似乎无法显示。怎么会这样?

这是我的Shell提取代码:

' declare the Win32 API function SHGetFileInfo'
Public Declare Auto Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlags As Integer) As IntPtr
' declare some constants that SHGetFileInfo requires'
Public Const SHGFI_ICON As Integer = &H100
Public Const SHGFI_SMALLICON As Integer = &H1
' define the SHFILEINFO structure'
Structure SHFILEINFO
    Public hIcon As IntPtr
    Public iIcon As Integer
    Public dwAttributes As Integer
    <Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> _
    Public szDisplayName As String
    <Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=80)> _
    Public szTypeName As String
End Structure

Function RetrieveShellIcon(ByVal argPath As String) As Image
    Dim mShellFileInfo As SHFILEINFO
    Dim mSmallImage As IntPtr
    Dim mIcon As System.Drawing.Icon
    Dim mCompositeImage As Image
    mShellFileInfo = New SHFILEINFO
    mShellFileInfo.szDisplayName = New String(Chr(0), 260)
    mShellFileInfo.szTypeName = New String(Chr(0), 80)
    mSmallImage = SHGetFileInfo(argPath, 0, mShellFileInfo, System.Runtime.InteropServices.Marshal.SizeOf(mShellFileInfo), SHGFI_ICON Or SHGFI_SMALLICON)
    ' create the icon from the icon handle'
    Try
        mIcon = System.Drawing.Icon.FromHandle(mShellFileInfo.hIcon)
        mCompositeImage = mIcon.ToBitmap
    Catch ex As Exception
        ' create a blank black bitmap to return'
        mCompositeImage = New Bitmap(16, 16)
    End Try
    ' return the composited image'
    Return mCompositeImage
End Function

Function GetIcon(ByVal argFilePath As String) As Image
    Dim mFileExtension As String = System.IO.Path.GetExtension(argFilePath)
    ' add the image if it doesn't exist''
    If cIcons.ContainsKey(mFileExtension) = False Then
        cIcons.Add(mFileExtension, RetrieveShellIcon(argFilePath))
    End If
    ' return the image'
    Return cIcons(mFileExtension)
End Function

这就是我显示文件图标的方式。

    Dim lvi As ListViewItem
    Dim di As New DirectoryInfo(Form2.TextBox1.Text)
    Dim exts As New List(Of String)
    ImageList1.Images.Clear()
    If di.Exists = False Then
        MessageBox.Show("Source path is not found", "Directory Not Found", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Else
        For Each fi As FileInfo In di.EnumerateFiles("*.*")

            lvi = New ListViewItem
            lvi.Text = fi.Name

            lvi.SubItems.Add(((fi.Length / 1024)).ToString("0.00"))
            lvi.SubItems.Add(fi.CreationTime)

            If exts.Contains(fi.Extension) = False Then
                Dim mShellIconManager As New Form1
                For Each mFilePath As String In My.Computer.FileSystem.GetFiles(Form2.TextBox1.Text)
                    ImageList1.Images.Add(fi.Extension, GetIcon(mFilePath))
                    exts.Add(fi.Extension)
                Next

            End If
            lvi.ImageKey = fi.Extension
            ListView1.Items.Add(lvi)
        Next

这是我显示文件夹图标的方式,但似乎无法正常工作

For Each fldr As String In Directory.GetDirectories(Form2.TextBox1.Text)
            Dim mShellIconManager As New Form1

            lvi = New ListViewItem
            lvi.Text = Path.GetFileName(fldr)

            lvi.SubItems.Add(((fldr.Length / 1024)).ToString("0.00"))
            lvi.SubItems.Add(Directory.GetCreationTime(fldr))


            ImageList1.Images.Add(GetIcon(fldr))
            ListView1.Items.Add(lvi)            
Next

1 个答案:

答案 0 :(得分:2)

您的代码中有一些内容。其中一些看起来像以前尝试的残余。无论如何,这有效:

Public Partial Class NativeMethods
    Private Const MAX_PATH As Integer = 256
    Private Const NAMESIZE As Integer = 80
    Private Const SHGFI_ICON As Int32 = &H100

    <StructLayout(LayoutKind.Sequential)> 
    Private Structure SHFILEINFO
        Public hIcon As IntPtr
        Public iIcon As Integer
        Public dwAttributes As Integer
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)>
        Public szDisplayName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=NAMESIZE)>
        Public szTypeName As String
    End Structure

    <DllImport("Shell32.dll")> 
    Private Shared Function SHGetFileInfo(pszPath As String,
                                          dwFileAttributes As Integer,
                                          ByRef psfi As SHFILEINFO,
                                          cbFileInfo As Integer,
                                          uFlags As Integer) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True)>
    Private Shared Function DestroyIcon(hIcon As IntPtr) As Boolean
    End Function

    Public Shared Function GetShellIcon(path As String) As Bitmap
        Dim shfi As SHFILEINFO = New SHFILEINFO()

        Dim ret As IntPtr = SHGetFileInfo(path, 0, shfi, Marshal.SizeOf(shfi), SHGFI_ICON)
        If ret <> IntPtr.Zero Then
            Dim bmp As Bitmap = System.Drawing.Icon.FromHandle(shfi.hIcon).ToBitmap
            DestroyIcon(shfi.hIcon)
            Return bmp
        Else
            Return Nothing
        End If
    End Function
End Class

将PInvoke代码放在自己的类中有几个好处。首先,它有助于将代码与所有那些神奇的数字,结构和常量隔离开来。 PInvoke可以是私有的,并通过方法(GetShellIcon)公开,该方法执行所有scut工作并调用API方法。此外,VS CodeAnalysis工具在从NativeMethods类使用它时不会抱怨它。

您的代码未执行的操作之一是销毁检索到的图标并释放该资源;你的SHGetFileInfo看起来也不正确,这会导致坏事。当它无法获取图标时,我不会在PInvoke代码中创建空白/空位图,而是返回Nothing以便处理代码。

最后,使用封装的PInvoke代码更容易使用和缩短:

Dim fPath As String = "C:\Temp"
Dim di = New DirectoryInfo(fPath)
' store imagelist index for known/found file types
Dim exts As New Dictionary(Of String, Int32)

Dim img As Image
Dim lvi As ListViewItem
For Each d In di.EnumerateDirectories("*.*", SearchOption.TopDirectoryOnly)
    lvi = New ListViewItem(d.Name)
    lvi.SubItems.Add("")        ' no file name
    lvi.SubItems.Add(Directory.GetFiles(d.FullName).Count().ToString)

    myLV.Items.Add(lvi)

    img = NativeMethods.GetShellIcon(d.FullName)
    imgLst.Images.Add(img)
    lvi.ImageIndex = imgLst.Images.Count - 1
Next

For Each f In di.EnumerateFiles("*.*")
    lvi = New ListViewItem(f.DirectoryName)
    lvi.SubItems.Add(f.Name)        ' no file name
    lvi.SubItems.Add("n/a")

    myLV.Items.Add(lvi)
    If exts.ContainsKey(f.Extension) = False Then
        ' try simplest method
        img = Drawing.Icon.ExtractAssociatedIcon(f.FullName).ToBitmap
        If img Is Nothing Then
            img = NativeMethods.GetShellIcon(f.FullName)
        End If
        If img IsNot Nothing Then
            imgLst.Images.Add(img)
            exts.Add(f.Extension, imgLst.Images.Count - 1)
        Else
            ' ?? use some default or custom '?' one?
        End If

    End If

    lvi.ImageIndex = exts(f.Extension)
Next

对于该文件,它首先尝试使用NET Icon.ExtractAssociatedIcon方法获取图标,并因某种原因转向该失败的PInvoke。

我将exts List(Of String更改为Dictionary(Of String, Int32)。代码获取扩展程序的图标后,会将该图像的索引保存在ImageList中,以便不再需要查找扩展程序/图标。这大大加快了它在大文件夹上的速度。

如果您在方法之外声明Dictionary,然后每次都不清除ImageList,则可以让它们在运行时累积图像。文件夹text file中的Foo图标不会与其他文本文件的图像不同。

结果:
enter image description here enter image description here