'模塊中的代碼
Option Explicit
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_LARGEICON = &H0
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_SMALLICON = &H1
Public Const SHGFI_SYSICONINDEX = &H4000
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 Const MAX_PATH = 260
Public Const ILD_TRANSPARENT = &H1
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 As Long, ByVal i As Long, _
ByVal hDCDest As Long, ByVal x As Long, _
ByVal y As Long, ByVal flags As Long) As Long
Public shinfo As SHFILEINFO
Public Const SHGFI_USEFILEATTRIBUTES = &H10
Public Const SHGFI_ICON = &H100
'===================================================
'新建壹個窗體，在窗體上添加壹個TextBox用來輸入文件路徑
'和兩個picturebox用來顯示提取到的圖標
'以下是窗體中的代碼
Private Sub Picture2_Click()
VB.SavePicture Picture2, App.Path & "\ico.ico"
End Sub
Private Sub Text1_Change() '要顯示的圖標路徑
Dim hImgSmall As Long
Dim fName As String '驅動器號、文件夾名、文件名
Dim r As Long
Dim hImgLarge As Long
Dim Info1 As String, Info2 As String
fName = Text1.Text
hImgSmall& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), SHGFI_ICON Or SHGFI_SMALLICON Or SHGFI_SYSICONINDEX Or SHGFI_USEFILEATTRIBUTES)
hImgLarge& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), SHGFI_ICON Or BASIC_SHGFI_FLAGS Or SHGFI_SYSICONINDEX Or SHGFI_USEFILEATTRIBUTES)
Info1 = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
Info2 = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
Debug.Print Info1; Info2
Picture1.Picture = LoadPicture()
Picture1.AutoRedraw = True
Picture2.Picture = LoadPicture()
Picture2.AutoRedraw = True
r = ImageList_Draw(hImgSmall&, shinfo.iIcon, Picture1.hDC, 0, 0, ILD_TRANSPARENT)
r = ImageList_Draw(hImgLarge&, shinfo.iIcon, Picture2.hDC, 3, 3, ILD_TRANSPARENT)
Set Picture1.Picture = Picture1.Image
Set Picture2.Picture = Picture2.Image
End Sub