按文件类型取图标

 1 '以下在.Bas
 2 Option Explicit
 3 Public Const SHGFI_DISPLAYNAME = &H200
 4 Public Const SHGFI_EXETYPE = &H2000
 5 Public Const SHGFI_LARGEICON = &H0
 6 Public Const SHGFI_SHELLICONSIZE = &H4
 7 Public Const SHGFI_SMALLICON = &H1
 8 Public Const SHGFI_SYSICONINDEX = &H4000
 9 Public Const SHGFI_TYPENAME = &H400
10 Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
11 Public Const MAX_PATH = 260
12 Public Const ILD_TRANSPARENT = &H1
13 Public Type SHFILEINFO
14    hIcon As Long
15    iIcon As Long
16    dwAttributes As Long
17    szDisplayName As String * MAX_PATH
18    szTypeName As String * 80
19 End Type
20 Public Declare Function SHGetFileInfo Lib _
21    "shell32.dll" Alias "SHGetFileInfoA" _
22    (ByVal pszPath As String, _
23     ByVal dwFileAttributes As Long, _
24     psfi As SHFILEINFO, _
25     ByVal cbSizeFileInfo As Long, _
26     ByVal uFlags As Long) As Long
27 Public Declare Function ImageList_Draw Lib "comctl32.dll" _
28    (ByVal himl As Long, ByVal i As Long, _
29     ByVal hDCDest As Long, ByVal x As Long, _
30     ByVal y As Long, ByVal flags As Long) As Long
31 Public shinfo As SHFILEINFO
32 Public Const SHGFI_USEFILEATTRIBUTES = &H10
33 Public Const SHGFI_ICON = &H100
34 
35 
36 'FORM中  控件    Picture1 、Picture1 、Text1    代码
37 
38 
39 Private Sub Picture2_Click()
40 VB.SavePicture Picture2, App.Path & "\ico.ico"
41 End Sub
42 
43 Private Sub Text1_Change()
44    Dim hImgSmall As Long
45    Dim fName As String
46    Dim r As Long
47    Dim hImgLarge As Long
48    Dim Info1 As String, Info2 As String
49    fName = Text1.Text
50    hImgSmall& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), SHGFI_ICON Or SHGFI_SMALLICON Or SHGFI_SYSICONINDEX Or SHGFI_USEFILEATTRIBUTES)
51    hImgLarge& = SHGetFileInfo(fName$, 0&, shinfo, Len(shinfo), SHGFI_ICON Or BASIC_SHGFI_FLAGS Or SHGFI_SYSICONINDEX Or SHGFI_USEFILEATTRIBUTES)
52    Info1 = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
53    Info2 = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
54    Debug.Print Info1; Info2
55    Picture1.Picture = LoadPicture()
56    Picture1.AutoRedraw = True
57    Picture2.Picture = LoadPicture()
58    Picture2.AutoRedraw = True
59    r = ImageList_Draw(hImgSmall&, shinfo.iIcon, Picture1.hDC, 0, 0, ILD_TRANSPARENT)
60    r = ImageList_Draw(hImgLarge&, shinfo.iIcon, Picture2.hDC, 3, 3, ILD_TRANSPARENT)
61    Set Picture1.Picture = Picture1.Image
62    Set Picture2.Picture = Picture2.Image
63 End Sub
64 
65