|
'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 |
