以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助] 获取文件对应的图标  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=56054)

--  作者:lsy
--  发布时间:2014/8/28 16:01:00
--  [求助] 获取文件对应的图标

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

 

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

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

现在就是要把当前节点目录下的文件,显示到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


--  作者:有点甜
--  发布时间:2014/8/28 16:44:00
--  

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

 

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()


--  作者:lsy
--  发布时间:2014/8/28 16:47:00
--  

真的呀?!

马上就试。

谢谢。


--  作者:有点甜
--  发布时间:2014/8/28 17:00:00
--  

根据后缀名得到的,参考

 

全局代码

 

<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

[此贴子已经被作者于2014-8-28 17:00:04编辑过]

--  作者:lsy
--  发布时间:2014/8/28 17:20:00
--  

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

再次感谢。


--  作者:lsy
--  发布时间:2014/8/28 17:37:00
--  
我把4楼的代码,写成函数,在目录树事件中调用。
--  作者:lsy
--  发布时间:2014/8/29 16:35:00
--  

提取图标,是很方便。

 

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


--  作者:有点甜
--  发布时间:2014/8/29 16:52:00
--  
以下是引用lsy在2014-8-29 16:35:00的发言:

提取图标,是很方便。

 

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

 

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

 

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


--  作者:lsy
--  发布时间:2014/8/29 17:04:00
--  
以下是引用有点甜在2014-8-29 16:52:00的发言:

 

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

 

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

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


--  作者:lsy
--  发布时间:2014/8/29 17:09:00
--  
提取不到,都是未知格式的图标。