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
- 'General Declarations:
- Private Type TypeIcon
- cbSize As Long
- picType As PictureTypeConstants
- hIcon As Long
- End Type
-
- Private Type CLSID
- id(16) As Byte
- End Type
-
- Private Const MAX_PATH = 260
- Private Type SHFILEINFO
- hIcon As Long ' out: icon
- iIcon As Long ' out: icon index
- dwAttributes As Long ' out: SFGAO_ flags
- szDisplayName As String * MAX_PATH ' out: display name (or path)
- szTypeName As String * 80 ' out: type name
- End Type
-
- Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
- 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
-
- Private Const SHGFI_ICON = &H100
- Private Const SHGFI_LARGEICON = &H0
- Private Const SHGFI_SMALLICON = &H1
-
- ' Convert an icon handle into an IPictureDisp.
- Private Function IconToPicture(hIcon As Long) As IPictureDisp
- Dim cls_id As CLSID
- Dim hRes As Long
- Dim new_icon As TypeIcon
- Dim lpUnk As IUnknown
-
- With new_icon
- .cbSize = Len(new_icon)
- .picType = vbPicTypeIcon
- .hIcon = hIcon
- End With
- With cls_id
- .id(8) = &HC0
- .id(15) = &H46
- End With
- hRes = OleCreatePictureIndirect(new_icon, _
- cls_id, 1, lpUnk)
- If hRes = 0 Then Set IconToPicture = lpUnk
- End Function
-
- 'Icon function
- Private Function GetIcon(FileName As String, icon_size As Long) As IPictureDisp
- Dim index As Integer
- Dim hIcon As Long
- Dim item_num As Long
- Dim icon_pic As IPictureDisp
- Dim sh_info As SHFILEINFO
-
- SHGetFileInfo FileName, 0, sh_info, _
- Len(sh_info), SHGFI_ICON + icon_size
- hIcon = sh_info.hIcon
- Set icon_pic = IconToPicture(hIcon)
- Set GetIcon = icon_pic
- End Function
-
- 'Use these functions for the program e.g. Picture1.Picture = GetBigIcon("C:\Autoexec.bat")
- Public Function GetSmallIcon(FileName As String) As IPictureDisp
- Set GetSmallIcon = GetIcon(FileName, SHGFI_SMALLICON)
- End Function
-
- Public Function GetBigIcon(FileName As String) As IPictureDisp
- Set GetBigIcon = GetIcon(FileName, SHGFI_LARGEICON)
- End Function
-
- 'Ví du.
- Private Sub Command2_Click()
- Picture1.Picture = GetBigIcon("E:\aNDy desiGn\VINH TAI\VT_090323.pdf")
- Picture2.Picture = GetSmallIcon("E:\aNDy desiGn\VINH TAI\VT_090323.pdf")
- End Sub