VB Forum / Win API / June 2008

Of course, if you use MS news server, you won't find usenet newsgroups  !
Use any free news server like
news://194.177.96.26/comp.os.ms-windows.programmer.win32
or http://groups.google.com/ ...

Thorsten Albers <albersRE@MOVEuni-freiburg.de> schrieb im Beitrag
<01c8cf06$3b7d9b20$af01a8c0@Router>...

I have to correct myself: 'ChangChiThegraphics' obviously also wants to
know how to get the icon of the application associated with certain file
types...

ChangChiTheGraphics <ChangChiTheGraphics@discussions.microsoft.com> schrieb
im Beitrag <6BC54A3E-6390-4EC4-BC74-156F43D80F56@microsoft.com>...

a) Some icons (files, directories) used by the Windows Explorer may be
retrieved by using SHGetFileInfo() as I have suggested before. To get more
information on this please refer to the documentation on SHGetFileInfo().

b) Other icons used by the Windows Explorer are included as resources in
the executable of the Windows Explorer. These icons can be extracted by
certain procedures in the Windows API at run time, or with a resource
editor at design time. But AFAIK their use in other applications is not
covered by the end user license agreement (EULA) shipped with the explorer.

=?Utf-8?B?Q2hhbmdDaGlUaGVHcmFwaGljcw==?=

Well, here's a bas module I use to get icons. It has 2 functions,
GetIcon, which returns an IPictureDisplay...

ex. - Picture1.Picture = GetIcon("c:\windows\",SHGFI_SMALLICON)

And GetIconIcon, which returns a handle to an icon...an hIcon.

In the code you will see a couple of API calls/Constants with a win(dot)
prefix, like win.SHFILEINFO. I use a Windows API typelib, so that is why
it is like that. To use straight API, you would need to add declarations
for each.

You can also pass a CSLID to retreive icons of 'virtual' folders, like
the Recycle Bin, Network Hood, etc.

This page a CSLID's for many shellspace objects...

http://www.webtropy.com/articles/art14-2.asp?Interop=Shell32

Note though, the better way to do this is to attach to the
SystemImageList.

Why ? For instance, if you call GetIcon on a directory filled with .jpg
images, you would be getting the same icon over and over again. You would
need to keep track of what you already have extracted and use the
existing ones. If not, you can quickly fill up an imagelist and use gobs
more memmory than necessary.

You can google for systemimagelist if you want. I'm sure there's an
example over at mvps.org.

Begin modIcons.bas----------------------------------------------

Public Type TypeIcon
   cbSize As Long
   picType As PictureTypeConstants
   hIcon As Long
End Type

Public Type CLSID
   ID(16) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll"
(pDicDesc As TypeIcon, _
           riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long

Public Function GetIcon(Filename As String, icon_size As Long) As
IPictureDisp
   'Dim Index As Long
   Dim hIcon As Long
   'Dim item_num As Long
   Dim icon_pic As IPictureDisp
   Dim sh_info As win.SHFILEINFO

   Call win.SHGetFileInfo(Filename, 0, sh_info, _
       Len(sh_info), win.SHGFI_ICON + icon_size)
   hIcon = sh_info.hIcon
   Set icon_pic = IconToPicture(hIcon)
   
   Set GetIcon = icon_pic
   'win.DestroyIcon hIcon
   
End Function

Public Function GetIconIcon(Filename As String, icon_size As Long) As
Long
   'Dim Index As Long
   Dim hIcon As Long
   'Dim item_num As Long
   'Dim icon_pic As IPictureDisp
   Dim sh_info As win.SHFILEINFO

   Call win.SHGetFileInfo(Filename, 0, sh_info, _
       Len(sh_info), win.SHGFI_ICON + icon_size)
   hIcon = sh_info.hIcon
   GetIconIcon = hIcon
       
End Function

Public Function IconToPicture(hIcon As Long) As IPictureDisp
   Dim cls_id As CLSID
   Dim hRes As Long
   Dim new_icon As TypeIcon
   Dim lpUnk As IUnknown

   With new_icon
       .cbSize = Len(new_icon)
       .picType = vbPicTypeIcon
       .hIcon = hIcon
   End With
   With cls_id
       .ID(8) = &HC0
       .ID(15) = &H46
   End With
   hRes = OleCreatePictureIndirect(new_icon, _
       cls_id, 1, lpUnk)

   If hRes = 0 Then Set IconToPicture = lpUnk
   
End Function

End modIcons.bas----------------------------------------------