• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 190
  • Last Modified:

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 !

   
0
pgg
Asked:
pgg
  • 2
1 Solution
 
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
 
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

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now