使用Listview时，如何像资源管理器一样显示文件的图标时会根据文件的类型来选择图标?

也请虫子老大给我一份：[email protected]
谢谢！

请给我一份学习一下：[email protected] 谢谢！

这里是一个类模块：
复制下面的代码到记事本并保存为 cFileIcon.clsOption Explicit
'/////////////////////////////////////////////////////////////
'
' cFileIcon Class
'
' load file icon to imagelist, then display it in listview
'
'/////////////////////////////////////////////////////////////Private Const MAX_PATH = 260Private Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End TypePrivate Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
    (ByVal pszPath As String, ByVal dwAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long

Private Enum EShellGetFileInfoConstants
        SHGFI_ICON = &H100                ' // get icon
        SHGFI_DISPLAYNAME = &H200            ' // get display name
        SHGFI_TYPENAME = &H400            ' // get type name
        SHGFI_ATTRIBUTES = &H800            ' // get attributes
        SHGFI_ICONLOCATION = &H1000        ' // get icon location
        SHGFI_EXETYPE = &H2000            ' // return exe type
        SHGFI_SYSICONINDEX = &H4000        ' // get system icon index
        SHGFI_LINKOVERLAY = &H8000        ' // put a link overlay on icon
        SHGFI_SELECTED = &H10000            ' // show icon in selected state
        SHGFI_ATTR_SPECIFIED = &H20000    ' // get only specified attributes
        SHGFI_LARGEICON = &H0                ' // get large icon
        SHGFI_SMALLICON = &H1                ' // get small icon
        SHGFI_OPENICON = &H2                ' // get open icon
        SHGFI_SHELLICONSIZE = &H4            ' // get shell size icon
        SHGFI_PIDL = &H8                    ' // pszPath is a pidl
        SHGFI_USEFILEATTRIBUTES = &H10    ' // use passed dwFileAttribute
End EnumPrivate Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End TypePrivate Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
      lpPictDesc As PictDesc, _
      riid As Guid, _
      ByVal fPictureOwnsHandle As Long, _
      ipic As IPicture _
   ) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As LongPublic Enum EGetIconTypeConstants
    egitSmallIcon = 1
    egitLargeIcon = 2
End Enum'//private var and objects
Private cfPath         As cFileNamePath
Private sTmpDir     As StringPrivate sExtKey     As StringPrivate Sub Class_Initialize()
'//start
    Set cfPath = New cFileNamePath

    '//get temp folder
    Dim cfs As cFileSystem
    Set cfs = New cFileSystem
    sTmpDir = cfs.GetTempFolder
    Set cfs = Nothing

    '//
    sExtKey = "|"

End SubPrivate Sub Class_Terminate()
'//end
    Set cfPath = Nothing
End Sub
Public Function GetIcon( _
    ByVal sFile As String, _
    Optional ByVal EIconType As EGetIconTypeConstants = egitLargeIcon) As Object    Dim lR      As Long
    Dim hIcon   As Long
    Dim tSHI    As SHFILEINFO
    Dim lFlags  As Long

    ' Prepare flags for SHGetFileInfo to get the icon:
    If (EIconType = egitLargeIcon) Then
        lFlags = SHGFI_ICON Or SHGFI_LARGEICON
    Else
        lFlags = SHGFI_ICON Or SHGFI_SMALLICON
    End If

    lFlags = lFlags And Not SHGFI_LINKOVERLAY
    lFlags = lFlags And Not SHGFI_OPENICON
    lFlags = lFlags And Not SHGFI_SELECTED

    ' Call to get icon:
    lR = SHGetFileInfo(sFile, 0&, tSHI, Len(tSHI), lFlags)
    If (lR <> 0) Then
        ' If we succeeded, the hIcon member will be filled in:
        hIcon = tSHI.hIcon
        ' If we have an icon, convert it to a VB picture and return it:
        If Not (hIcon = 0) Then
            Set GetIcon = IconToPicture(hIcon)
        End If
    End If

End FunctionPrivate Function IconToPicture(ByVal hIcon As Long) As IPicture

    If hIcon = 0 Then Exit Function

    ' This is all magic if you ask me:
    Dim NewPic As Picture, PicConv As PictDesc, IGuid As Guid

    PicConv.cbSizeofStruct = Len(PicConv)
    PicConv.picType = vbPicTypeIcon
    PicConv.hImage = hIcon

    'IGuid.Data1 = &H20400
    'IGuid.Data4(0) = &HC0
    'IGuid.Data4(7) = &H46

    ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect PicConv, IGuid, True, NewPic

    Set IconToPicture = NewPic

End FunctionPublic Function AddIconToImageList( _
    ByRef sFile As String, _
    ByRef ilsThis As ImageList, _
    ByRef ilsThisBig As ImageList, _
    Optional ByVal bAddRealFileicon As Boolean = False) As String

    Dim sExt    As String
    Dim i       As Long

    'Dim sTempFile As String
    'Dim iFile As Long

    Dim iIndex  As Long

    Dim sTmpFile    As String
    Dim fNum        As Long    sExt = "I." & UCase(cfPath.GetFileExtention(sFile))

    If Len(sExt) > 2 Then
        '//already exist
        If InStr(1, sExtKey, "|" & sExt & "|") > 0 Then
            AddIconToImageList = sExt
            Exit Function
        End If

        sExtKey = sExtKey & sExt & "|"  '//append this file-extend-name

        '//##Debug.Print "add icon: " & sExt

        '//create a temp file to get icon from it
        sTmpFile = sTmpDir & sExt
        fNum = FreeFile

        Open sTmpFile For Binary Access Write As #fNum
        Put #fNum, , 0
        Close #fNum

        '//get icon from temp file
        ilsThis.ListImages.Add , sExt, GetIcon(sTmpFile, egitSmallIcon)
        ilsThisBig.ListImages.Add , sExt, GetIcon(sTmpFile, egitLargeIcon)

        AddIconToImageList = sExt

        KillFile sTmpFile   '//delete temp file
    End IfEnd FunctionPrivate Sub KillFile(sFile As String)
   On Error Resume Next
   Kill sFile
End Sub////////////////////////////////////////////////////////////////在窗口中添加两个 imageList 和一个 listview要显示图标就这样调用：dim ci as new cFileIcon
dim s  as string
dim itm as listitem
s=ci.AddIconToImageList ("c:\test.txt",imageList1,imageList2)set itm=listview1.listitem.add
itm.icon=s
itm.smallicon=s

Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As LongPrivate Sub Form_Paint()
    Dim mIcon As Long
    'Extract the associated icon
    mIcon = ExtractAssociatedIcon(App.hInstance, "C:\test.txt", 2)
    'Draw the icon on the form
    DrawIconEx Me.hDC, 0, 0, mIcon, 0, 0, 0, 0, DI_NORMAL
    'remove the icon from the memory
    DestroyIcon mIcon
End Sub

调试易

使用Listview时，如何像资源管理器一样显示文件的图标时会根据文件的类型来选择图标?

解决方案 »