說明

這個程式是使用SHGetFileInfo() API 他的宣告如下

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

如果其最後一參數 uFlags 如果含有 SHGFI_ICON(or SHGFI_LARGEICON) OR SHGFI_SYSICONINDEX , 則傳回值是含有大圖示(Large Icon)之 handle of the system image。若是SHGFI_SMALLICON則傳回值是含有小圖示(Small Icon)之handle of the System image list.

另外，第三個參數是接收 ShfileInfo Structure的傳回，ShfileInfo.iIcon 指的是該檔案的Icon是在hImgSmall/ hImgLarge 所指的System Image List中，所存之所有Icon中的第幾個Icon，有了它，配合ImageList_Draw便可以畫出該Icon。

程式

'以下在Form ，一個CommonDialog1  一個Command button  2個PictureBox
Private Sub Command1_Click()

   Dim hImgSmall As Long   'the handle to the system image list(Small Icon)
   Dim fName As String    'the file name to get icon from
   Dim fnFilter As String  'the file name filter
   Dim r As Long
   Dim hImgLarge As Long  'the handle to the system image list(Large Icon)
   Dim Info1 As String, Info2 As String
   'get the file from the user   fnFilter$ = "All Files (*.*)|*.*|"
   fnFilter = fnFilter & "Applications (*.exe)|*.exe|"
   fnFilter = fnFilter & "Windows Bitmap (*.bmp)|*.bmp|"
   fnFilter = fnFilter & "Icon Files (*.ico)|*.ico"

   CommonDialog1.CancelError = True
   CommonDialog1.Filter = fnFilter
   CommonDialog1.ShowOpen

   fName = CommonDialog1.filename

  'get the system icon associated with that file
   hImgSmall& = SHGetFileInfo(fName$, 0, _
         shinfo, Len(shinfo), _
         BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)

   hImgLarge& = SHGetFileInfo(fName$, 0&, _
         shinfo, Len(shinfo), _
         BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)

   'fill in the labels with the image's file data
   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

  'draw the associated icons into the pictureboxes
   r = ImageList_Draw(hImgSmall&, shinfo.iIcon, Picture1.hDC, 0, 0, ILD_TRANSPARENT)
   r = ImageList_Draw(hImgLarge&, shinfo.iIcon, Picture2.hDC, 0, 0, ILD_TRANSPARENT)

  'realize the images by assigning its
  'image property (where the icon was drawn)
  'to the actual picture property
   Set Picture1.Picture = Picture1.Image
   Set Picture2.Picture = Picture2.Image
End Sub
 

---


'以下在.Bas
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

相關資訊

  SHGetFileInfo

  SHFILEINFO

文件出處

  VB NET

如果對本站有任何建議,歡迎來信給Honey,我們會盡快給您答覆