リストビューにアイコンを表示するには？ (ID:85053)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 どのようにうまくいっていないのかはわかりませんが、 前回のスレッドとほぼ同じ内容ですよね。 サンプルを作ってみましたので試してみてください。 Option Explicit Private Type IconType cbSize As Long picType As PictureTypeConstants hIcon As Long End Type Private Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * 260 szTypeName As String * 80 End Type Private Type CLSIdType id(16) As Byte End Type Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" _ (pDicDesc As IconType, riid As CLSIdType, ByVal fown As Long, _ lpUnk As Object) As Long 'スペシャル（システム）なフォルダを取得するための定数 'なのだがサンプルでは未使用 Private Const CSIDL_DESKTOP = &H0 Private Const CSIDL_INTERNET = &H1 Private Const CSIDL_PROGRAMS = &H2 Private Const CSIDL_CONTROLS = &H3 Private Const CSIDL_PRINTERS = &H4 Private Const CSIDL_PERSONAL = &H5 Private Const CSIDL_FAVORITES = &H6 Private Const CSIDL_STARTUP = &H7 Private Const CSIDL_RECENT = &H8 Private Const CSIDL_SENDTO = &H9 Private Const CSIDL_BITBUCKET = &HA Private Const CSIDL_STARTMENU = &HB Private Const CSIDL_MYDOCUMENTS = &HC Private Const CSIDL_MYMUSIC = &HD Private Const CSIDL_MYVIDEO = &HE Private Const CSIDL_DESKTOPDIRECTORY = &H10 Private Const CSIDL_DRIVES = &H11 Private Const CSIDL_NETWORK = &H12 Private Const CSIDL_NETHOOD = &H13 Private Const CSIDL_FONTS = &H14 Private Const CSIDL_TEMPLATES = &H15 'Private Const CSIDL_COMMON_STARTMENU = &H16 'Private Const CSIDL_COMMON_PROGRAMS = &H17 'Private Const CSIDL_COMMON_STARTUP = &H18 'Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 Private Const CSIDL_APPDATA = &H1A Private Const CSIDL_PRINTHOOD = &H1B Private Const CSIDL_LOCAL_APPDATA = &H1C Private Const CSIDL_ALTSTARTUP = &H1D Private Const CSIDL_COMMON_ALTSTARTUP = &H1E Private Const CSIDL_COMMON_FAVORITES = &H1F Private Const CSIDL_INTERNET_CACHE = &H20 Private Const CSIDL_COOKIES = &H21 Private Const CSIDL_HISTORY = &H22 Private Const SHGFI_ICON = &H100 Private Const SHGFI_LARGEICON = &H0 Private Const SHGFI_SMALLICON = &H1 Private Const SHGFI_PIDL = &H8 Private Const SHGFI_DISPLAYNAME = &H200& Private ret As Long Private Sub Form_Load() Dim DispName As String Dim IPic As IPictureDisp Dim CSIDL As Long Dim ImgCnt As Long Dim SHFI As SHFILEINFO Dim pid As Long ListView1.Arrange = lvwAutoTop 'CSIDL_XXXXという定数を使用して行うのだが、めんどいのでFor文でループ For CSIDL = 0 To &H22 Select Case CSIDL Case &HF, &H16 To &H19 Case Else 'スペシャルフォルダのPIDLを取得 ret = SHGetSpecialFolderLocation(Me.hWnd, CSIDL, pid) 'スペシャルフォルダの小さいアイコンのハンドル取得 ret = SHGetFileInfo(pid, 0, SHFI, Len(SHFI), SHGFI_PIDL Or SHGFI_ICON Or SHGFI_SMALLICON) Set IPic = IconToIPicture(SHFI.hIcon) If Not (IPic Is Nothing) Then ImgCnt = ImgCnt + 1 ImageList1.ListImages.Add , , IPic 'スペシャルフォルダの表示文字列及び大きいアイコンのハンドル取得 ret = SHGetFileInfo(pid, 0, SHFI, Len(SHFI), SHGFI_PIDL Or SHGFI_ICON Or SHGFI_LARGEICON Or SHGFI_DISPLAYNAME) Set IPic = IconToIPicture(SHFI.hIcon) ImageList2.ListImages.Add , , IPic If ImgCnt = 1 Then ListView1.SmallIcons = ImageList1 ListView1.Icons = ImageList2 End If ListView1.ListItems.Add , , SHFI.szDisplayName, ImgCnt End If End Select Next End Sub Private Sub Form_Resize() If Me.ScaleWidth <= 0 Then Exit Sub With ListView1 .Left = 0 .Top = 0 .Width = Me.ScaleWidth .Height = Me.ScaleHeight End With End Sub Private Function IconToIPicture(hIcon As Long) As IPictureDisp Dim pic As IconType Dim IPic As IPictureDisp Dim IID_IDispatch As CLSIdType Dim ret As Long IID_IDispatch.id(8) = &HC0 IID_IDispatch.id(15) = &H46 With pic .cbSize = Len(pic) .picType = vbPicTypeIcon .hIcon = hIcon End With ret = OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic) Set IconToIPicture = IPic End Function