主题：[求助] 获取文件对应的图标

系统中的文件夹目录树，好是好，可不听俺的使唤。

 

想自己做一个类似的，想咋摆弄就咋摆弄。

目录树已经做好了，分步生成，速度非常快。

现在就是要把当前节点目录下的文件，显示到ListView控件中。

 

光有文件名，没相应的图标，显的太业余。

 

从网上搜到两段代码，哪位有兴趣，改造成狐表可调用的代码。

 

先谢了！

 

[VB]获得文件及文件夹图标模块 

一、****************************************************************************************************************************************
调用：GetFileInfo(文件或文件夹路径,小图标PictureBox,大图标PictureBox)
返回：文件注册的类型名称

Private Const SHGFI_ICON = &H100         '图标
Private Const SHGFI_LARGEICON = &H0      '大图标
Private Const SHGFI_SMALLICON = &H1      '小图标
Private Const SHGFI_TYPENAME = &H400     '类型名
Private Type SHFILEINFO
   hIcon As Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * 260
   szTypeName As String * 80
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
  (ByVal pszPath As String, _
   ByVal dwFileAttributes As Long, _
   psfi As SHFILEINFO, _
   ByVal cbSizeFileInfo As Long, _
   ByVal uFlags As Long) As Long
Private Declare Function DrawIcon Lib "user32" _
  (ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal hIcon As Long) As Long

Public Function GetFileInfo(FileName As String, SmallIcon As PictureBox, LargeIcon As PictureBox)
  Dim fileInfo As SHFILEINFO
  SHGetFileInfo FileName, 0, fileInfo, Len(fileInfo), SHGFI_ICON Or SHGFI_SMALLICON
  LargeIcon.AutoRedraw = True
  DrawIcon LargeIcon.hdc, 0, 0, fileInfo.hIcon
  SmallIcon.AutoRedraw = True
  SmallIcon.PaintPicture LargeIcon.Image, 0, 0, 16, 16, 0, 0, 32, 32
  LargeIcon.Cls
  SHGetFileInfo FileName, 0, fileInfo, Len(fileInfo), SHGFI_ICON Or SHGFI_LARGEICON Or SHGFI_TYPENAME
  DrawIcon LargeIcon.hdc, 0, 0, fileInfo.hIcon
  GetFileInfo = Left(fileInfo.szTypeName, InStr(fileInfo.szTypeName, Chr$(0)) - 1)
End Function

 

 

二、*****************************************************************************************************************************************
VB获取文件图标，同时还可获取文件的图标句柄、图标系统的系统索引号、文件的属性、文件的显示名、文件的类型名，依赖于shell32.dll、comctl32.dll等。

Attribute VB_Name = "Mdl_GetICO"
Option Explicit
'获取文件图标
Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000  ' System icon index
Public Const SHGFI_LARGEICON = &H0        ' Large icon
Public Const SHGFI_SMALLICON = &H1        ' Small icon
Public Const ILD_TRANSPARENT = &H1        ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE _
    Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME _
    Or SHGFI_EXETYPE
Public Type SHFILEINFO
    hIcon As Long                           '文件的图标句柄
    iIcon As Long                           '图标的系统索引号
    dwAttributes As Long                    '文件的属性
    szDisplayName As String * MAX_PATH      '文件的显示名
    szTypeName As String * 80               '文件的类型名
End Type
Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, _
    ByVal dwFileAttributes As Long, _
    psfi As SHFILEINFO, _
    ByVal cbSizeFileInfo As Long, _
    ByVal uFlags As Long _
    ) As Long
Public Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, _
    ByVal i&, _
    ByVal hDCDest&, _
    ByVal X&, _
    ByVal y&, _
    ByVal flags& _
    ) As Long
Public shinfo As SHFILEINFO

 查了一下资料，发觉原来直接用就可以了

 

Dim icon As Icon = System.Drawing.Icon.ExtractAssociatedIcon("d:\test.xls")

'直接使用icon

'Dim fileStream As new System.IO.FileStream("d:\test.ico", System.IO.FileMode.Create)
'icon.Save(fileStream)
'fileStream.Close()

真的呀？！

马上就试。

谢谢。

根据后缀名得到的，参考

 

全局代码

 

<System.Runtime.InteropServices.DllImportAttribute("shell32.dll", EntryPoint := "ExtractIconExW", CallingConvention := System.Runtime.InteropServices.CallingConvention.StdCall)> _
Public Function ExtractIconExW(<System.Runtime.InteropServices.InAttribute> <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.LPWStr)> lpszFile As String, nIconIndex As Integer, ByRef phiconLarge As System.IntPtr, ByRef phiconSmall As System.IntPtr, nIcons As UInteger) As UInteger
End Function

 

------------

 

获取代码

 

Dim extsubkey = Registry.ClassesRoot.OpenSubKey(".xls")
'从注册表中读取扩展名相应的子键
If extsubkey IsNot Nothing Then
    Dim extdefaultvalue = DirectCast(extsubkey.GetValue(Nothing), String)
    '取出扩展名对应的文件类型名称
    Dim typesubkey = Registry.ClassesRoot.OpenSubKey(extdefaultvalue)
    '从注册表中读取文件类型名称的相应子键
    If typesubkey IsNot Nothing Then
        Dim description = DirectCast(typesubkey.GetValue(Nothing), String)
        '得到类型描述字符串
        Dim defaulticonsubkey = typesubkey.OpenSubKey("DefaultIcon")
        '取默认图标子键
        If defaulticonsubkey IsNot Nothing Then
            '得到图标来源字符串
            Dim defaulticon = DirectCast(defaulticonsubkey.GetValue(Nothing), String)
            '取出默认图标来源字符串
            Dim iconstringArray = defaulticon.Split(","C)
            Dim nIconIndex As Integer = 0
            If iconstringArray.Length > 1 Then
                Integer.TryParse(iconstringArray(1), nIconIndex)
            End If
            '得到图标
           
            Dim phiconLarge As new System.IntPtr
            Dim phiconSmall As new System.IntPtr
            ExtractIconExW(iconstringArray(0).Trim(""""C), nIconIndex, phiconLarge, phiconSmall, 1)
            Dim icon As icon = Icon.FromHandle(phiconLarge)
            Dim fileStream As new System.IO.FileStream("d:\test.ico", System.IO.FileMode.Create)
            icon.Save(fileStream)
            fileStream.Close()
        End If
    End If
End If

按照2楼的方法，已经抠出来图标了。

再次感谢。

我把4楼的代码，写成函数，在目录树事件中调用。

提取图标，是很方便。

 

怎么提取的图标，都这么丑呢？不像系统中的那么鲜活。

 

提取Icon保存为.ico格式，就是有偏差的，如果你要完整的，可以保存成图片

 

Dim icon As Icon = System.Drawing.Icon.ExtractAssociatedIcon("d:\test.xls")
icon.ToBitmap().save("d:\aaaaaa.ico")

好，试试这个，宁少勿丑。

提取不到，都是未知格式的图标。