Finding the default icon for Any file

I need to display a number of files in a listview control. How do I find the default Icon for the selected file, and how do I save it to a ListImage control ?

I use the code below :
lRet = SHGetFileInfo(spath, 0&, shFileStruct, Len(shFileStruct), SHGFI_ICON)
Call DrawIcon(Picture1.hdc, 0, 0, shFileStruct.hIcon)

Will paint a picturebox with the icon, but what to do next ??

Thankx !

   
pggAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Erick37Commented:
The function IconToPicture takes an icon handle and makes a StdPicture object from it.  You can then put the picture in your imagelist.  More info:
http://www.dogma.demon.co.uk/tips/vba0024.htm

Example:


Option Explicit
Const SHGFI_ICON = &H100
Const SHGFI_LARGEICON = &H0
Const SHGFI_SMALLICON = &H1
Private Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * 260
    szTypeName As String * 80
End Type
Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type
Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
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
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
    (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, _
    ipic As IPicture) As Long

Public Function IconToPicture(ByVal hIcon As Long) As IPicture
    If hIcon = 0 Then Exit Function
    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid
   
    With tPicConv
    .cbSizeofStruct = Len(tPicConv)
    .picType = vbPicTypeIcon
    .hImage = hIcon
    End With
   
    ' 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 tPicConv, IGuid, True, oNewPic
    Set IconToPicture = oNewPic
End Function

Private Sub Command1_Click()
    'Usage
    Dim lRet As Long
    Dim sPath As String
    Dim shFileStruct As SHFILEINFO
    sPath = "c:\anim.gif"
    lRet = SHGetFileInfo(sPath, 0&, shFileStruct, _
            Len(shFileStruct), SHGFI_ICON)
    'Convert handle to picture and put in pic box or image list
    Picture1.Picture = IconToPicture(shFileStruct.hIcon)
End Sub
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bob LearnedCommented:
Dim imgX As ListImage
   Set imgX = ImageList1.ListImages. _
   Add(1,"Image 1",Picture1.Image)

Make sure the AutoRedraw is set to true for the PictureBox.
0
Erick37Commented:
Picture1.Image does not retain transparency of the icon.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.