Images in a list box 1

[Bubbler]

Is it possible to include the icons next to the names of the list box that is populated via a folder full of .lnk files? Like in a windows start menu?

From what I can find on the net, it is not, but I have to ask here because if it is possible, this forum would know!

 

[Hypetia]

It will be quite difficult (although not impossible) to show shortcut icons in a standard vb list box. You have to make your list box owner-drawn, which requires lot of painful API stuff including GDI drawing and subclassing. However, if you use a listview control, things will become easier.

Try the following code. Just place a listview control (ListView1) and an imagelist control (ImageList1) on your form and run it. It will show all the shortcuts in the Programs folder with their icon, target location and comments.

This code makes use of Windows Scripting Host's Shortcut object which plays a vital role in querying the data from the shortcut file. In addition to that a few API functions are also used.
___
[tt]
Option Explicit
Dim WSH As WshShell
Private Declare Function ExtractIconEx Lib "shell32" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Sub CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Guid)
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 Sub Form_Load()
With ListView1 'initialize listview
.View = lvwReport
.LabelEdit = lvwManual
.ColumnHeaders.Add , , "Name", 2000
.ColumnHeaders.Add , , "Comments", 4500
.ColumnHeaders.Add , , "Target", 4500
End With
With ImageList1 'initialize imagelist
.ImageWidth = 16
.ImageHeight = 16
.MaskColor = vbBlack
.UseMaskColor = True
End With
Set WSH = New WshShell 'initialize the shell object
Const CSIDL_PROGRAMS = &H2 'API constant for programs folder
'load shortcuts from the programs folder
LoadFolderShortcuts WSH.SpecialFolders(CSIDL_PROGRAMS)
WindowState = vbMaximized
End Sub

Private Sub Form_Resize()
ListView1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Sub LoadFolderShortcuts(ByVal Folder As String)
Set ListView1.SmallIcons = Nothing 'deassociate the imagelist from the list view
ImageList1.ListImages.Clear 'Clear previously added shortcuts
ListView1.ListItems.Clear 'and icon images (if any).
If Right$(Folder, 1) <> &quot;\&quot; Then Folder = Folder & &quot;\&quot;
Dim lnkFile As String, objShortcut As WshShortcut
Dim IconFile As String, IconIndex As Long, V() As String
'now loop thru all .lnk files in the given folder
lnkFile = Dir$(Folder & &quot;*.lnk&quot
While Len(lnkFile)
'create a shortcut object form the filename
'we will examine this object to extract the
'target filename, comments and icon location.
Set objShortcut = WSH.CreateShortcut(Folder & lnkFile)
'split the icon location into file/index
V = Split(objShortcut.IconLocation, &quot;,&quot
IconFile = Trim$(V(0)) 'first part is icon file
'if icon file is missing then use target path
If IconFile = &quot;&quot; Then IconFile = objShortcut.TargetPath
IconIndex = Val(V(1)) 'second part is icon index
'add shortcut icon to the imagelist
ImageList1.ListImages.Add Picture:=GetIconObjectFromFile(IconFile, IconIndex)

With ListView1.ListItems.Add 'add new item to list view and specify its
.Text = lnkFile 'shortcut name
.SubItems(1) = objShortcut.Description 'comments and
.SubItems(2) = objShortcut.TargetPath 'target location.
End With

'destroy the shortcut object, we don't need it any more.
Set objShortcut = Nothing

lnkFile = Dir$ 'next .lnk file
Wend
Set ListView1.SmallIcons = ImageList1 'reassociate the imagelist to the listview
Dim N As Long
For N = 1 To ListView1.ListItems.Count 'and initialize the small icon indexes
ListView1.ListItems(N).SmallIcon = N
Next
End Sub
'this function accepts the path of an executable (or DLL) file, an icon index
'it contains and returns a picture object representing that icon in the file.
Function GetIconObjectFromFile(IconFile As String, IconIndex As Long) As StdPicture
Dim hIcon As Long, pd As PICTDESC, IPic As Guid
ExtractIconEx IconFile, IconIndex, 0, hIcon, 1 'extract the small icon
'fill the pd(PICTDESC) structure
pd.cbSizeofStruct = Len(pd)
pd.picType = vbPicTypeIcon
pd.hImage = hIcon
'convert the IPicture interface CLSID to GUID format
CLSIDFromString ByVal StrPtr(&quot;{7BF80980-BF32-101A-8BBB-00AA00300CAB}&quot, IPic
'create the stdPicture object
OleCreatePictureIndirect pd, IPic, True, GetIconObjectFromFile
End Function[/tt]
___

I have tried to document the code as much as possible.

With a little effort, you can also make this code to scan the folders recursively so that all the shortcuts in the entire start menu are mapped to the listview. This solely depends on your requirement and interest. Many examples of recursive folder scanning can be found on this site including thread222-654507 and thread222-609352.

 

[Hypetia]

Forgot to mention a couple of things.

1. You need to add a reference to Windows Script Host Object Model library.
2. And of course, need to add Microsoft Windows Common Controls to your controls toolbox.

 

[Bubbler]

Works great Hypetia, but I can't figure out why it looks at the C:\Program Files\Movie Maker, I want it to look at C:\Program Files\ccl\app

Where is this path C:\Program Files\Movie Maker drawn from?

 

[LPlates]

Option Explicit

Private Declare Function SHGetSpecialFolderLocation Lib &quot;shell32.dll&quot; (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib &quot;shell32.dll&quot; Alias &quot;SHGetPathFromIDListA&quot; (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Public Enum TSpecialFolders
DM_DESKTOP = &H0
DM_PROGRAMS = &H2
DM_Controls = &H3
DM_PRINTERS = &H4
DM_PERSONAL = &H5
DM_FAVORITES = &H6
DM_STARTUP = &H7
DM_RECENT = &H8
DM_SENDTO = &H9
DM_BITBUCKET = &HA
DM_STARTMENU = &HB
DM_DESKTOPDIRECTORY = &H10
DM_DRIVES = &H11
DM_NETWORK = &H12
DM_NETHOOD = &H13
DM_FONTS = &H14
DM_TEMPLATES = &H15
End Enum

Private Const NOERROR As Long = 0

Public Function GetSpecialFolderLocation(TFolder As TSpecialFolders) As String
Dim StrBuff As String
Dim RetVal As Long
Dim IDL As ITEMIDLIST
RetVal = SHGetSpecialFolderLocation(100, TFolder, IDL)
If RetVal = NOERROR Then
StrBuff = String(512, Chr(0))
RetVal = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal StrBuff)
GetSpecialFolderLocation = Left(StrBuff, InStr(StrBuff, Chr(0)) - 1)
Exit Function
End If
GetSpecialFolderLocation = vbNullString

End Function

'FORM

Option Explicit

Private Sub Command1_Click()
Debug.Print GetSpecialFolderLocation(DM_DESKTOP)
End Sub