按文件类型取图标

 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 

 

转载于:https://www.cnblogs.com/xxaxx/archive/2009/12/29/1635314.html