Results 1 to 21 of 21

Thread: VB6 - Get Associated Sm/Lg Icon

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Lightbulb VB6 - Get Associated Sm/Lg Icon

    This is a VB6 static (.BAS) module containing one function: GetAssocIcon().

    You pass it a relative or absolute file name, and whether you want a large (32x32) or small (16x16) icon.
    • For .ico files you get back the icon.
    • For programs you get back the program icon (as displayed in Explorer).
    • For data files, documents, etc. you get back the default program's icon.
    • You can also pass it an extension alone, as in ".txt" to get the associated program's icon.

    The icon is returned as a StdPicture (Picture) object, for easy use in native-VB operations such as adding it to an ImageList control, Image control, etc.

    It will almost certainly work in VB5 as well, but I haven't tried that. There should be no special requirements such as a Windows version or any extra dependencies.

    Unlike examples based on ExtractAssociatedIcon() calls, this one offers both the large and small icon formats.

    The attachment contains a small demo project.
    Attached Files Attached Files
    Last edited by dilettante; Aug 7th, 2011 at 01:08 PM. Reason: Reposted attachment, no-DestroyIcon version

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Note:

    It will also return folder and drive icons.

  3. #3
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    Two points/questions. I haven't tested anything I'm putting out here. I'll leave that you and others

    1. If you check the .Handle of the returned stdPicture object, if the .Handle and the SFI.hIcon are identical; shouldn't be destroying it. For bitmaps, OLE doesn't generally copy the image; it wraps a class around the handle. Not sure if icons are handled the same by OLE

    2. Have you tried this on Vista/Win7 where the associated icon may be 32bpp? Just curious. I'm thinking that 32bpp may be returned and 'converted' to 256 colors and, if so, look pretty shabby
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Quote Originally Posted by LaVolpe View Post
    1. If you check the .Handle of the returned stdPicture object, if the .Handle and the SFI.hIcon are identical; shouldn't be destroying it. For bitmaps, OLE doesn't generally copy the image; it wraps a class around the handle. Not sure if icons are handled the same by OLE
    You could be right, I'll check the values.

    But:
    SHGetFileInfo Function

    Remarks

    If SHGetFileInfo returns an icon handle in the hIcon member of the SHFILEINFO structure pointed to by psfi, you are responsible for freeing it with DestroyIcon when you no longer need it.
    And:
    OleCreatePictureIndirect Function

    Remarks

    The fOwn parameter indicates whether the picture is to own the GDI picture handle for the picture it contains, so that the picture object will destroy its picture when the object itself is destroyed. The function returns an interface pointer to the new picture object specified by the caller in the riid parameter. A QueryInterface is built into this call. The caller is responsible for calling Release through the interface pointer returned.
    I'm calling with fOwn = True


    Ok, tried it. Testing the 4 cases in the demo, the two handles have identical values each time. Yet everything works fine calling DestroyIcon on SFI.hIcon here.

    I appreciate the input and I'll test the other issue, but I'm not sure about your suggestion not to destroy SFI.hIcon at this point.

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Quote Originally Posted by LaVolpe View Post
    2. Have you tried this on Vista/Win7 where the associated icon may be 32bpp? Just curious. I'm thinking that 32bpp may be returned and 'converted' to 256 colors and, if so, look pretty shabby
    Seems to work.

    I tried a call against Environ$("SystemRoot") & "\system32\SnippingTool.exe" first. Works fine, new utility introduced on Vista but I have not extracted its icon to verify 32bpp images in it. Looks like it in various Explorer views though. Ok, extracted the icon and yes it has 9 images, 4 of them at 32bpp.

    Also created an .ico file with just two images: 32-bit 32x32 and 32-bit 16x16 (Using IcoFX). Works fine. Of course VB6 won't load it as a Form icon as expected.

    Uplaoding the .ico in case you want to do a sanity check!

    Oops!

    Went back and added an alpha "shadow" and yeah, looks kinda lousy now. Updated attachment too.
    Attached Files Attached Files
    Last edited by dilettante; Aug 6th, 2011 at 08:14 PM. Reason: update: extracted SnippingTool icon and took a peek

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Yep, even with an icon that has images at lower bitplane levels it seems to pick the 32bpp ones and "adjust" them. The result is muddy for an icon with heavy shadowing.

  7. #7
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    Quote Originally Posted by dilettante View Post
    Yep, even with an icon that has images at lower bitplane levels it seems to pick the 32bpp ones and "adjust" them. The result is muddy for an icon with heavy shadowing.
    That was my guess from past experiences. No way really to get around it unfortunately. You can't tell the API which icon to pick. I believe it uses the screen resolution as part of its decision process (standard windows decision process with icons).

    Regarding destroying/not destroying. I don't know if you checked the return value of your DestroyIcon call. It may be returning zero - failure? If so, then the icon is leaked because the stdPicture object won't destroy it per the MSDN documentation. Recommendation: Set the parameter to True & don't destroy the icon, that way no guessing involved. When the stdPicture is destroyed so is the icon. Just a suggestion
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Hmm.

    Well DestroyIcon() is returning 1 (success).

    You say the icon could be leaked "because the stdPicture object won't destroy it per the MSDN documentation" but you say "Recommendation: Set the parameter to True & don't destroy the icon, that way no guessing involved. When the stdPicture is destroyed so is the icon."

    I give up, what am I misinterpreting? Seriously, I'm just trying to avoid breakin' da rules, not being difficult.


    On the alpha front I think you're correct. I was hoping at first the translucent pixels would all be mapped to a known mask color or something helpful, but no. That might cause distortions of its own anyway.

    I'm not giving up, but I don't want a raft of GDI calls and looping through pixel arrays adjusting alpha thresholds mask pixels either.

  9. #9
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    I don't trust the return result of DestroyIcon or even DeleteObject all the time. Here's how I see it. If .hIcon and .Handle are identical, then the icon wasn't destroyed, regardless of return results of DestroyIcon. Here's a simple test

    1. Leave that parameter as True
    2. Rem out the DestroyIcon call
    3. Debug.Print the handle
    4. Run project and create an icon so it's handle is printed out. Close form & return to IDE
    5. Add this code to a test button (APIs also provided) & run project & click button. After running it, you'll see that the icon was destroyed even without the DestroyIcon call. Therefore, calling DestroyIcon with a True parameter sent to that OLE API can only cause potential issues (though it appears the icon is not being destroyed even if DestroyIcon says it is).
    Code:
    Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
    Private Declare Function GetIconInfo Lib "user32.dll" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
    Private Type ICONINFO
        fIcon As Long
        xHotspot As Long
        yHotspot As Long
        hbmMask As Long
        hbmColor As Long
    End Type
    
    '>>> button click
        Dim II As ICONINFO
        Dim hIcon As Long
        hIcon = Val(InputBox("Enter the icon handle below"))
        If hIcon Then
            If GetIconInfo(hIcon, II) = 0& Then
                MsgBox "That icon handle is no longer valid"
            Else
                If II.hbmColor Then DeleteObject II.hbmColor
                If II.hbmMask Then DeleteObject II.hbmMask
                MsgBox "Icon handle is valid"
            End If
        End If
    I guess all I was getting at was that by using a True parameter, no need to be destroying the handle sent to the OLE API. Trying to destroy the handle can only cause problems that may only surface in runtime or after app has been running for some time? Don't know but not worth the risk IMO.

    Regarding alpha values in icons.... Here's something to play with if you want to
    A 32bpp icon has a mask; though it shouldn't really be used since the alpha channel dictates transparency. But VB doesn't understand the alpha channel (Vb is too old) and uses the mask. I think you can prove this very easily.
    1. Create a 32bpp icon with heavy shadowing (i.e., good use of alpha channel)
    2. Provide a solid fully opaque mask (all 0's no 1's)
    3. Load that icon in an app that supports 32bpp. It should render shadows ok even though the mask is fully opaque
    4. Run your project again & choose that icon. VB will display a fully opaque icon
    Last edited by LaVolpe; Aug 7th, 2011 at 12:15 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  10. #10

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Ok great news and confusing news.

    On the confusing front, I do suspect a GDI memory leak. However it isn't clear to me that commenting out the DestroyIcon call in GetAssocIcon() as done in the second demo attached here resolves the problem.

    I need to find a way to measure this.

    The great news?

    Even with alpha icons this works great in ListViews and TreeViews (at least the ones based on Windows Common Controls in COMCTL32.OCX, if not the yet untried VB6 versions in MSCOMCTL.OCX). And those are the places I need to use these icons anyway, as would most people.

    Note that the Michigan Map icons with alpha shadows were a little muddy for their size at best anyway, I was using heavy shadows on purpose here.
    Attached Images Attached Images  
    Attached Files Attached Files
    Last edited by dilettante; Aug 7th, 2011 at 01:23 PM. Reason: REposted attachment, no-DestroyIcon, plus an added menu!

  11. #11

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    While trying to measure GDI leaks, I discovered that if I call DestroyIcon() then the program will bomb trying to add the icon to an ImageList (VB5.0 style anyway). "Out of Memory" error 9 I think.

    So... the DestroyIcon() call has to go anyway!


    I'll look at your other suggestions too, but considering the intended applications I think we're in pretty good shape with the logic as it is now.

  12. #12
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    With XP there is a new size of icons: 48x48. Vista introduced the jumbo size icon: 256x256. Both these sizes can be extracted using the same API, but on XP and above, a new API was introduced to allow you to get the icon from the correct system image list & yet another API required to extract it.

    If interested, I can post the code. Unfortunately, these options make a simple call to SHGetFileInfo, as in your example, now obsolete. If you prefer, I can create a new thread that includes the XP/Vista+ options
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Well... I'm not sure I followed all of that. If you need to write programs that work on Win2K and earlier you still need to use SHGetFileInfo or something similar don't you?

    So I suppose one can use the newer API calls to create an "XP or later" and another "Vista and later" solution. Or maybe yet a third "flexible" solution that sniffs the OS version and uses the old-style technique pre-XP, scaling the large icon up to offer 48x48 and 256x256 when requested, as well as maybe using the new technique on XP for 48x48 and scaling that up for 256, etc.

    Or are you proposing a new solution that is simply broken pre-Vista?

    Three solutions then or four:
    • Universal solution limited to small and large.
    • "Requires XP" solution adding XP-size.
    • "Requires Vista" solution adding XP- and Vista-size.
    • Flexible solution using OS sniffing to provide all 4 sizes, synthesizing where necessary?

    Bit-stretching is pretty crude. Do you have a fast and light bilinear or better resampling routine or is there something in GDI that is usable?

  14. #14
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    I have a universal solution. Icons made for XP include at least a 48x48 version. For Vista & later, would include 256x256 also. There are up to 4 system image lists, depending on O/S, where SHGetFileInfo gets its icons from: 16x16, 32x32, 48x48 & 256x256. The SHGetFileInfo function appears to only return the 2 smaller lists & icons from those lists. There is a new API that came with XP that will get you the 48x48 image list. And on Vista & above it will get you the 256x256 list. From those lists, we can extract the icon directly with yet another API.

    Scaling up icons are not desirable if can be avoided -- horrible quality. Though through tests, this is exactly what happens should you request a 48x48 associated icon and none exists... The 32x32 gets scaled up. In these cases, it is mostly due to older apps, like VB for example, that do not have 48x48 or greater sized icons associated.

    Bottom line. Your example works perfectly for 32x32 & 16x16 icons. But there may be times when a 48x48 or better is needed/wanted. DPI scaling comes to mind.

    Edited: Picture's worth a 1000 words. The images below were extracted with 3 APIs: SHGetFileInfo, SHGetImageList & ImageList_GetIcon
    Obviously Vista system icons have all 4 sizes
    See what happens to VB.exe associated icon? The 48x48 is scaled up from its 32x32. If no 256x256 exists, Vista, at least, creates a 256x256 but simply draws the scaled 48x48 in the top/left of the icon
    Name:  assocIcon.png
Views: 4959
Size:  130.1 KB
    Last edited by LaVolpe; Jan 7th, 2012 at 02:30 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  15. #15

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    So how would you handle a program that needs to run on Win2K and wants to use a 48x48 or 256x256 image from an icon? Or needs to run on XP but wants a 256x256 image?

    That's the part I still don't understand. Of course "don't do that" (i.e. only support Vista and later, or XP and later) is a viable answer in some cases.

  16. #16

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    BTW:

    The main use I had for these was in ListView and TreeView type controls. Have you looked at how these change behavior/metrics under a High DPI setting yet? I guess I need to take a look at that too.

    I found this:
    Similarly, you can provide icons in four sizes, as shown in the following table.

    Code:
    DPI setting   Icon (SM_CXICON)   Small icon (SM_CXSMICON) 
      96            32x32              16x16
      120           40x40              20x20
      144           48x48              24x24
      192           64x64              32x32
    When your application renders its user interface, it should match the appropriate bitmap to the system dpi setting. If it is too expensive to create four versions of each interface graphic, consider providing two versions instead. The 96- and 120-dpi settings are most common. If you're deploying an application that's designed for a specific organization, you can optimize for the organization's most common hardware configuration.
    http://msdn.microsoft.com/en-us/libr...81(VS.85).aspx
    Last edited by dilettante; Jan 7th, 2012 at 03:10 AM.

  17. #17
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    Quote Originally Posted by dilettante View Post
    So how would you handle a program that needs to run on Win2K and wants to use a 48x48 or 256x256 image from an icon? Or needs to run on XP but wants a 256x256 image?
    You can't. The 48 & 256 size icon image lists don't exist. If someone needed a larger size, they'd have to extract it manually from the exe's resource itself (if the icon existed) or scale it. Shell32 doesn't have 48x48 on those O/S either, so scaling would be the only answer. However, if on XP, Vista or higher and one wanted a larger icon, then one can do it via the APIs I mentioned & at least for 48x48 automatic scaling (though ugly). I haven't yet tested how Win7 handles 256 requests when icon doesn't exist
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  18. #18

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    So are you really talking about programs for "modern Windows" letting XP and before fall by the wayside?

    I can see what you're suggesting to get the 48 and 256 sizes when they exist, but isn't that another topic? Though don't get me wrong, I'm not trying to limit the discussion to ImageLists and their clients, that's just where I began with all of this.

  19. #19
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    Regarding that table... I remember glancing over it a little while back. The 48x48 & 256x256 are not hard and fast sizes either. The 2 new sizes for SHGetFileInfo are ExtraLarge & Jumbo respetively. Per MSDN, ExtraLarge is usually 48x48 but can be changed by the user. I assume this is referring to DPI settings. They said same thing for the Jumbo 256 sizes

    I can see what you're suggesting to get the 48 and 256 sizes when they exist, but isn't that another topic?
    I didn't think so. Several days ago I helped someone trying to extract 48x48 icons from the system image list via SHGetFileInfo. When I happened upon this one again, I thought it would be good if this thread described how to get those size icons, along with the typical 16 & 32 sizes
    Last edited by LaVolpe; Jan 7th, 2012 at 03:21 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  20. #20

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - Get Associated Sm/Lg Icon

    Feel free to add an example, perhaps that does make more sense than diverging this topic into two threads.

  21. #21
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Get Associated Sm/Lg Icon

    Okie doke. I'll look at it later today; need to re-code it a tad bit from a project I'm currently using the code. That way it would be generic...

    Here it is. Copy & paste this into a class module. If successful, the function returns a valid HICON handle. It is up to you to destroy the handle. If you wish to convert it to a VB stdPicture object, dilettante's zip in post #1 will do that. Most larger sized icons will be alpha blended and VB doesn't do too well with those.
    Code:
    Option Explicit
    
    ' Unicode-aware class to retrieve associated icons via Windows system image lists
    
    Public Enum AssocIconSize    ' defined by Windows, not me
        aisLargeIcon32 = 0       ' 32x32
        aisSmallIcon16 = 1       ' 16x16
        aisExtraLargeIcon48 = 2  ' 48x48   XP+
        aisJumboIcon256 = 4      ' 256x256 Vista+
    End Enum
    
    Public Enum AssocIconType   ' defined by me
        aitGenericIcon = 0      ' icon relative to file type
        aitActualIcon = 1       ' icon actually associated with executables or special folders
        aitOpenedIcon = 2       ' icons may have a selected/open version. OR this value; i.e., aitGenericIcon Or aitOpenedIcon
    End Enum                    '   ^^ purposely same value as: SHGFI_OPENICON = 2
    
    Private Const MAX_PATH As Long = 260&
    ' http://msdn.microsoft.com/en-us/library/windows/desktop/bb762179%28v=vs.85%29.aspx
    Private Const SHGFI_PIDL As Long = &H8&
    Private Const SHGFI_USEFILEATTRIBUTES As Long = &H10&
    Private Const SHGFI_SYSICONINDEX As Long = &H4000&
    
    Private Type SHFILEINFO                     ' http://msdn.microsoft.com/en-us/library/windows/desktop/bb759792%28v=VS.85%29.aspx
       hIcon          As Long                   ' icon handle
       iIcon          As Long                   ' icon index in system image list
       dwAttributes   As Long                   ' file/folder attributes
       szDisplayName  As String * MAX_PATH      ' display name for the file/folder
       szTypeName     As String * 80            ' type of file
    End Type
    
    Private Const ILD_TRANSPARENT As Long = &H1&
    Private Const INVALID_HANDLE_VALUE As Long = -1&
    Private Const IID_IImageList    As String = "{46EB5926-582E-4017-9FDF-E8998DAA0950}"
    'Private Const IID_IImageList2   As String = "{192B9D83-50FC-457B-90A0-2B82A8B5DAE1}"
    
    Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByRef pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
    Private Declare Function SHGetFileInfoW Lib "shell32.dll" (ByRef pszPath As Any, ByVal dwFileAttributes As Long, ByVal psfi As Long, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
    
    Private Declare Function SHGetImageListXP Lib "shell32.dll" Alias "#727" (ByVal iImageList As Long, ByRef riid As Long, ByRef ppv As Any) As Long
    Private Declare Function SHGetImageList Lib "shell32.dll" (ByVal iImageList As Long, ByRef riid As Long, ByRef ppv As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef lpiid As Any) As Long
    Private Declare Function ImageList_GetIcon Lib "comctl32.dll" (ByVal hIML As Long, ByVal i As Long, ByVal flags As Long) As Long
    
    Private Declare Function GetVersion Lib "kernel32.dll" () As Long
    Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
    Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hWnd As Long) As Long
    
    Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
    Private Declare Function GetFileAttributesW Lib "kernel32.dll" (ByVal lpFileName As Long) As Long
    
    Private m_Version As Long ' 2=Vista or better 1=XP 0=other 4 = unicode
    
    Public Function GetAssociatedIconEx(IconSource As Variant, ByVal IconSize As AssocIconSize, ByVal IconType As AssocIconType) As Long
    
        ' IconSource can be in one of these formats
        '   A full path and/or filename. Required if IconType includes aitActualIcon
        '       Example. C:\Program Files\Internet Explorer\iexplore.exe
        '           if IconType includes aitActualIcon then real IE icon is returned else generic exe icon
        '   Any folder if wanting the generic folder icon. Specific folder icons require full path of actual folder
        '       Example. C:\Documents and Settings\LaVolpe\Favorites\
        '           if IconType is aitActualIcon then a 'star' shaped icon is returned on XP else generic folder icon
        '           when IconType is aitGenericIcon, ensure folders end with \
        '   Any valid lettered drive. IconType should be aitGenericIcon
        '       Example. C:\
        '   Any valid UNC. IconType can be either aitGenericIcon or aitActualIcon
        '       Example. \\company server\shared music\
        '   Any extension. IconType must be aitGenericIcon & extension preceded with dot
        '       Example. .zip will return generic icon for WinZip documents
        '   A null string to retrieve the generic "unknown" file type icon. IconType should be aitGenericIcon
        
        '   Numeric PIDL. Use variable type of Long
        '       PIDLs are always handled as if IconType is aitActualIcon
        '       If you want a generic icon type, you should expand your PIDL to a fully qualified path/filename and pass that instead
        '       What is a PIDL? This may interest you. http://ccrp.mvps.org/index.html?support/faqs/faqbrowse.htm
        
        Dim lRtn As Long, lFlags As Long
        Dim pIML As IUnknown, hIML As Long
        Dim sPath As String, SHFI As SHFILEINFO
        Dim GUID(0 To 3) As Long, lAttr As Long
        
        ' sanity checks first
        If VarType(IconSource) = vbString Then
            sPath = IconSource
        ElseIf VarType(IconSource) = vbLong Then
            lFlags = SHGFI_PIDL
        Else
            Exit Function
        End If
        
        If IconSize < aisLargeIcon32 Then               ' validate passed icon size
            IconSize = aisLargeIcon32
        ElseIf IconSize > aisJumboIcon256 Then
            IconSize = aisJumboIcon256
        ElseIf IconSize > aisExtraLargeIcon48 And IconSize < aisJumboIcon256 Then
            IconSize = aisExtraLargeIcon48
        End If
                                                        ' validate icon size supported
        If IconSize = aisExtraLargeIcon48 Then                                  ' not applicable for less than XP
            If (m_Version And 3&) = 0 Then IconSize = aisLargeIcon32
        ElseIf (IconSize = aisJumboIcon256) And ((m_Version And 3&) < 2&) Then  ' only for Vista+
            If (m_Version And 3&) = 0 Then IconSize = aisLargeIcon32 Else IconSize = aisExtraLargeIcon48
        End If
                                                        ' build the flags & attributes API values
        If (IconType And aitOpenedIcon) Then lFlags = lFlags Or aitOpenedIcon
        If (IconType And aitActualIcon) Then
            If (lFlags And SHGFI_PIDL) = 0 Then
                If (m_Version And 4&) Then
                    lRtn = GetFileAttributesW(StrPtr(sPath))
                Else
                    lRtn = GetFileAttributes(sPath)
                End If
                If lRtn = INVALID_HANDLE_VALUE Then
                    IconType = aitGenericIcon
                    lFlags = lFlags Or SHGFI_USEFILEATTRIBUTES
                    If Right$(sPath, 1) = "\" Then lAttr = vbDirectory
                Else
                    If (lRtn And vbDirectory) = vbDirectory Then lAttr = vbDirectory
                End If
            End If
        Else
            If (lFlags And SHGFI_PIDL) = 0 Then
                If Right$(sPath, 1) = "\" Then lAttr = vbDirectory
            End If
            lFlags = lFlags Or SHGFI_USEFILEATTRIBUTES
        End If
        
        If IconSize < aisExtraLargeIcon48 Then
            lFlags = lFlags Or SHGFI_SYSICONINDEX Or IconSize
        Else
            lFlags = lFlags Or SHGFI_SYSICONINDEX
        End If
                                                        ' call the API
        If (m_Version And 4&) Then ' unicode calls
            If (lFlags And SHGFI_PIDL) Then lRtn = CLng(IconSource) Else lRtn = StrPtr(sPath)
            hIML = SHGetFileInfoW(ByVal lRtn, lAttr, VarPtr(SHFI), Len(SHFI), lFlags)
        Else                        ' ansi system
            If (lFlags And SHGFI_PIDL) Then
                hIML = SHGetFileInfo(ByVal CLng(IconSource), lAttr, SHFI, Len(SHFI), lFlags)
            Else
                hIML = SHGetFileInfo(ByVal sPath, lAttr, SHFI, Len(SHFI), lFlags)
            End If
        End If
        
        ' on XP and above, the image list handle returned by SHGetFileInfo is not the ExtraLarge or Jumbo sized
        ' image lists as expected. We'll use SHGetImageList to get the correct handle
        
        If hIML Then
            If IconSize >= aisExtraLargeIcon48 Then      ' XP or greater O/S
                If IIDFromString(StrPtr(IID_IImageList), GUID(0)) = 0 Then
                    On Error Resume Next
                    lRtn = SHGetImageList(IconSize, GUID(0), ByVal VarPtr(pIML))
                    If lRtn = 0& Then
                        If Err Then     ' depending on service pack shell32 did not export SHGetImageList correctly
                            Err.Clear   ' so we try again using the ordinal exported
                            lRtn = SHGetImageListXP(IconSize, GUID(0), ByVal VarPtr(pIML))
                            If Err Then lRtn = hIML ' assign any non-zero value; will be using the hIML value
                        End If
                    End If
                    On Error GoTo 0
                    If lRtn = 0& Then hIML = ObjPtr(pIML)
                End If
            End If
            GetAssociatedIconEx = ImageList_GetIcon(hIML, SHFI.iIcon, ILD_TRANSPARENT)
        End If
    
    End Function
    
    Private Sub Class_Initialize()
    
        m_Version = GetVersion()
        Select Case (m_Version And &HFF&)
        Case Is > 5                 ' Vista or better
            m_Version = 2&
        Case 5                      ' XP or maybe not
            If ((m_Version And &HFF00&) \ &H100 > 0&) Then m_Version = 1& Else m_Version = 0&
        Case Else                   ' less than XP
            m_Version = 0&
        End Select
        If IsWindowUnicode(GetDesktopWindow) <> 0& Then m_Version = m_Version Or 4&
        
    End Sub
    Last edited by LaVolpe; Jan 7th, 2012 at 01:55 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width