Lấy icon Big & Small của một tập tin

[clarkkent]

Thủ thuật: Lấy icon Big & Small của một tập tin
Tác giả: sưu tầm
Mô tả: Lấy icon Big & Small của một tập tin

---

Mã: Chọn hết

1. 'General Declarations:
2. Private Type TypeIcon
3.     cbSize As Long
4.     picType As PictureTypeConstants
5.     hIcon As Long
6. End Type
7.  
8. Private Type CLSID
9.     id(16) As Byte
10. End Type
11.  
12. Private Const MAX_PATH = 260
13. Private Type SHFILEINFO
14.     hIcon As Long ' out: icon
15.     iIcon As Long ' out: icon index
16.     dwAttributes As Long ' out: SFGAO_ flags
17.     szDisplayName As String * MAX_PATH ' out: display name (or path)
18.     szTypeName As String * 80 ' out: type name
19. End Type
20.  
21. Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
22. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
23.  
24. Private Const SHGFI_ICON = &H100
25. Private Const SHGFI_LARGEICON = &H0
26. Private Const SHGFI_SMALLICON = &H1
27.  
28. ' Convert an icon handle into an IPictureDisp.
29. Private Function IconToPicture(hIcon As Long) As IPictureDisp
30. Dim cls_id As CLSID
31. Dim hRes As Long
32. Dim new_icon As TypeIcon
33. Dim lpUnk As IUnknown
34.  
35.     With new_icon
36.         .cbSize = Len(new_icon)
37.         .picType = vbPicTypeIcon
38.         .hIcon = hIcon
39.     End With
40.     With cls_id
41.         .id(8) = &HC0
42.         .id(15) = &H46
43.     End With
44.     hRes = OleCreatePictureIndirect(new_icon, _
45.         cls_id, 1, lpUnk)
46.     If hRes = 0 Then Set IconToPicture = lpUnk
47. End Function
48.  
49. 'Icon function
50. Private Function GetIcon(FileName As String, icon_size As Long) As IPictureDisp
51. Dim index As Integer
52. Dim hIcon As Long
53. Dim item_num As Long
54. Dim icon_pic As IPictureDisp
55. Dim sh_info As SHFILEINFO
56.  
57.     SHGetFileInfo FileName, 0, sh_info, _
58.         Len(sh_info), SHGFI_ICON + icon_size
59.     hIcon = sh_info.hIcon
60.     Set icon_pic = IconToPicture(hIcon)
61.     Set GetIcon = icon_pic
62. End Function
63.  
64. 'Use these functions for the program e.g. Picture1.Picture = GetBigIcon("C:\Autoexec.bat")
65. Public Function GetSmallIcon(FileName As String) As IPictureDisp
66. Set GetSmallIcon = GetIcon(FileName, SHGFI_SMALLICON)
67. End Function
68.  
69. Public Function GetBigIcon(FileName As String) As IPictureDisp
70. Set GetBigIcon = GetIcon(FileName, SHGFI_LARGEICON)
71. End Function
72.  
73. 'Ví du.
74. Private Sub Command2_Click()
75. Picture1.Picture = GetBigIcon("E:\aNDy desiGn\VINH TAI\VT_090323.pdf")
76. Picture2.Picture = GetSmallIcon("E:\aNDy desiGn\VINH TAI\VT_090323.pdf")
77. End Sub