• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Lấy icon Big & Small của một tập tin

Các thủ thuật về âm thanh, đồ họa, truyền thông đa phương tiện...
Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Lấy icon Big & Small của một tập tin

Gửi bàigửi bởi clarkkent » T.Hai 23/03/2009 1:45 pm

Thủ thuật: Lấy icon Big & Small của một tập tin
Tác giả: sưu tầm
Mô tả: Lấy icon Big & Small của một tập tin



Mã: Chọn hết

  1. 'General Declarations:
  2. Private Type TypeIcon
  3.     cbSize As Long
  4.     picType As PictureTypeConstants
  5.     hIcon As Long
  6. End Type
  7.  
  8. Private Type CLSID
  9.     id(16) As Byte
  10. End Type
  11.  
  12. Private Const MAX_PATH = 260
  13. Private Type SHFILEINFO
  14.     hIcon As Long ' out: icon
  15.     iIcon As Long ' out: icon index
  16.     dwAttributes As Long ' out: SFGAO_ flags
  17.     szDisplayName As String * MAX_PATH ' out: display name (or path)
  18.     szTypeName As String * 80 ' out: type name
  19. End Type
  20.  
  21. Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
  22. 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
  23.  
  24. Private Const SHGFI_ICON = &H100
  25. Private Const SHGFI_LARGEICON = &H0
  26. Private Const SHGFI_SMALLICON = &H1
  27.  
  28. ' Convert an icon handle into an IPictureDisp.
  29. Private Function IconToPicture(hIcon As Long) As IPictureDisp
  30. Dim cls_id As CLSID
  31. Dim hRes As Long
  32. Dim new_icon As TypeIcon
  33. Dim lpUnk As IUnknown
  34.  
  35.     With new_icon
  36.         .cbSize = Len(new_icon)
  37.         .picType = vbPicTypeIcon
  38.         .hIcon = hIcon
  39.     End With
  40.     With cls_id
  41.         .id(8) = &HC0
  42.         .id(15) = &H46
  43.     End With
  44.     hRes = OleCreatePictureIndirect(new_icon, _
  45.         cls_id, 1, lpUnk)
  46.     If hRes = 0 Then Set IconToPicture = lpUnk
  47. End Function
  48.  
  49. 'Icon function
  50. Private Function GetIcon(FileName As String, icon_size As Long) As IPictureDisp
  51. Dim index As Integer
  52. Dim hIcon As Long
  53. Dim item_num As Long
  54. Dim icon_pic As IPictureDisp
  55. Dim sh_info As SHFILEINFO
  56.  
  57.     SHGetFileInfo FileName, 0, sh_info, _
  58.         Len(sh_info), SHGFI_ICON + icon_size
  59.     hIcon = sh_info.hIcon
  60.     Set icon_pic = IconToPicture(hIcon)
  61.     Set GetIcon = icon_pic
  62. End Function
  63.  
  64. 'Use these functions for the program e.g. Picture1.Picture = GetBigIcon("C:\Autoexec.bat")
  65. Public Function GetSmallIcon(FileName As String) As IPictureDisp
  66. Set GetSmallIcon = GetIcon(FileName, SHGFI_SMALLICON)
  67. End Function
  68.  
  69. Public Function GetBigIcon(FileName As String) As IPictureDisp
  70. Set GetBigIcon = GetIcon(FileName, SHGFI_LARGEICON)
  71. End Function
  72.  
  73. 'Ví du.
  74. Private Sub Command2_Click()
  75. Picture1.Picture = GetBigIcon("E:\aNDy desiGn\VINH TAI\VT_090323.pdf")
  76. Picture2.Picture = GetSmallIcon("E:\aNDy desiGn\VINH TAI\VT_090323.pdf")
  77. End Sub


• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

Quay về “[VB] Âm thanh và Đồ họa”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách