-- 作者: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 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编辑过]
|