Treeview control without imagelist/using system imagelist in treeview 1

[MZwijacz]

I am reposting this here because I didn't get a response in the VB 5/6 forum. The getfileinfo api function returns the system imagelist (?) and index to the files icon. Is there a way of using this list and index in the treeview control ? Any help would be appreciated

I am writing an applicatiion that simulates explorer using the treeview control. I've been able to extract the icon from a file using the WinApi but have not found an example where I can use a picture without an imagelist. Its impractical to add all the files on a system to an image list.

Is there a way to do this ?

Thanks,

Michael Zwijacz
mzwijacz@tahoesnow.com

 

[strongm]

I'd start by wondering why you didn't get an answer in the VB5/6 forum...

The answer is that the Windows treeview control itself (which the VB Treeview control is merely a wrapper for) requires the image source to be an imagelist. ABout the only way around this is to subclass ite treeview control as an OWNERDRAW control. Of course, if you do this, you basically have to handle all the redrawing of the control's contents...

 

[paulbent]

I don't know if this will help but I use an image control and an invisible picture control to transfer the icon to the image control. This example is using ExtractIconEx to get the icon from an exe or dll and DrawIcon to draw it in the picture control.

Sub sAddIconToImageList(ByVal strExe As String, _
ByVal intFallBackID As Integer)

    '--- Given the name of an exe or dll file, extracts the first small icon
    '    and loads it in the image list bound to the treeview and listview controls
    
    '--- Parameters
    '     [In]
    '     strExe: full path & filename of exe or dll containing the icon resource
    '     intFallBackID: id of icon in res file to use if no icons found in the exe

    Dim objImg As ListImage       'New list image object
    Dim lngRtn As Long            'API function return value
    Dim ahLIcon(1 To 1) As Long   'Array to receive large icon handles
    Dim ahSIcon(1 To 1) As Long   'Array to receive small icon handles

    'Just in case we get an 'invalid picture' error at run-time
    On Error GoTo LocalErr
    
    'Extract the first icon and small icon from the file
    lngRtn = ExtractIconEx(strExe, CLng(0), ahLIcon(1), ahSIcon(1), 1)
     'Clear the picture box
    Set picIcon.Picture = LoadPicture("")
    picIcon.AutoRedraw = True
Reenter:
    If ahSIcon(1) = 0 Then
        'No icon, load a fall back
        Set picIcon.Picture = LoadResPicture(intFallBackID, vbResIcon)
    Else
        'Draw the icon in the picture box
        lngRtn = DrawIcon(picIcon.hdc, 0, 0, ahSIcon(1))
        'Assign the drawn image to the picture property
        picIcon.Picture = picIcon.Image
    End If
    picIcon.AutoRedraw = False
    picIcon.Refresh
    
    'Add the icon to the image list from the picture control
    Set objImg = imgIcon.ListImages.Add(, strExe & CStr(mintImgCount), picIcon.Picture)
    'Increment the globalcounter
    mintImgCount = mintImgCount + 1
    
    GoTo ExitSub
    
LocalErr:
    If Err.Number = 481 Then
        'Invalid picture, load the fallback icon
        ahSIcon(1) = 0
        Resume Reenter
    Else
        'Tidy up
        DestroyIcon ahLIcon(1)
        DestroyIcon ahSIcon(1)
        Set objImg = Nothing
        'Turn off local handler
        On Error GoTo 0
        'Pass the error up the call stack
        Err.Raise Err.Number, Err.Description
    End If
    
ExitSub:
    DestroyIcon ahLIcon(1)
    DestroyIcon ahSIcon(1)
    Set objImg = Nothing
    
End Sub

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[vb5prgrmr]

Why can't you use an empty imagelist and load the icons as needed into it at runtime?

Just a thought

Good Luck

 

[MZwijacz]

Thank you for responding. I've been away from the office for a couple of days and just saw the responses.

re: response 1. I'm not sure I would be capable of handling all of the redrawing. This would probably be the best low level approch but I'm not sure my skills could do it.

re: response 2. This looks like the most promising I will give this a try on Monday and let you know the results.

re: response 3. I will probably use response 2 to build the list. Since I am working with an entire harddrive I'd like to find a way to save the icons and search for them quickly. I'm concerned with the performance hit of building the list every time on startup or on displaying the files. This is a multiuser solution so different people would be accessing different files; different icons. I'm now thinking there should be some sort of permenant storage for the icons. Maybe a database ?

Thank you all for your responces. I would appreciate the dialog to brainstorm through these questions.

Thanks,
Michael F. Zwijacz

 

[MZwijacz]

I have finally gotten back to this project. Using ExtractAssociatedIcon and Pauls post I've been able to extract the icon and display it in a picturebox, from there I add it to the imagelist control. The problem now is that the icon displays too small.

Are there any tricks on scaling the icon removed from the file when it's in the picture box before it is added to the image list ? I'm using a 16x16 image list. Right now I'll be playing with the size of the picture box, on a trial and error basis.

Thanks,
Michael F. Zwijacz

 

[vb5prgrmr]

Well looking at paulbent's code above they are placing the small icon in the picture box. I think/belive that if you change this line ...
[tt]
lngRtn = DrawIcon(picIcon.hdc, 0, 0, ahSIcon(1))
[/tt]
to
[tt]
lngRtn = DrawIcon(picIcon.hdc, 0, 0, ahLIcon(1))
[/tt]
It should correct your problem, else there is BitBlt or other image handling API's that may help.

Good Luck

 

[MZwijacz]

Thanks,

I have set my picture box size to 650x650 twips and its better. I will access the large icon and see if it is any better.

Michael Zwijacz

 

[MZwijacz]

I have come up with the following functions and subs. These extract the icon and save it to an image list. The problem now is to search the image list. The only way I've found is to itterate through the image list with the index. Is it possible to search for the key value only ? That way I could just do something like

if not imglist.key = "searchstring" then
add picturebox.picture to imglist
else
do nothing
end if

Here are the functions and subs and how I'm using them. I'm using the file extension as the key value:

Private Sub GetFileIcon(strPath As String)
Dim lngIcon As Long 'API function Icon handle
Dim lngRtn As Long 'API function return value

'Get Icon from file
lngIcon = ExtractAssociatedIcon(1, strPath, 0)

'Clear picture box
PicIcon.AutoRedraw = True
Set PicIcon.Picture = LoadPicture("&quot


'Draw the icon in the picture box
lngRtn = DrawIcon(PicIcon.hdc, 3, 3, lngIcon)

'Assign the drawn image to the picture property
PicIcon.Picture = PicIcon.Image


End Sub
Public Function GetExtension(strPath As String) As String
Dim iPos As Integer

'Get position of .
iPos = InStrRev(strPath, ".&quot
mSelectedExt = Trim(Mid(strPath, iPos + 1, 255))
GetExtension = mSelectedExt
End Function

Public Sub AddIcon(Pic As PictureBox, strkey As String)
imgListTree16.ListImages.Add , strkey, Pic.Picture
End Sub

Public Function Check4Icon(strkey As String) As Boolean
Dim iCount As Integer

For iCount = 1 To imgListTree16.ListImages.Count
If imgListTree16.ListImages.Item(iCount).Key = strkey Then
iCount = imgListTree16.ListImages.Count
Check4Icon = True
Exit Function
End If
Next
Check4Icon = False
End Function

____________________________________________________

For Each file In files
strExt = GetExtension(file.Name)

If Not Check4Icon(strExt) Then
Call GetFileIcon(file.Path)
Call AddIcon(PicIcon, strExt)
End If
Set nodtree = tvwNav.Nodes.Add(Node, tvwChild, Node.Key & "\" & file.Name, file.Name, strExt)
Next

Thanks,
Michael F. Zwijacz

 

[vb5prgrmr]

Give this (or something like it) a try...
[tt]
Option Explicit

Private Sub Command1_Click()

Debug.Print DoesImageExist("New&quot
Debug.Print DoesImageExist("does not exist&quot

End Sub

Private Function DoesImageExist(strKey As String) As Boolean

On Error GoTo DoesImageExistError

Dim LI As ListImage

Set LI = IL.ListImages(strKey)

DoesImageExist = True

Set LI = Nothing

Exit Function
DoesImageExistError:

Set LI = Nothing

End Function
[/tt]

Good Luck

 

[MZwijacz]

vb5prgrmr,

I tried something like that, listbox.listimages("strkey&quot but got a message that the index value was invalid.

It's working in alpha form now so I'm going to let this issue lie. I'll revisit this topic when I start optimizing this module.

Thank you for your help ! It's working and I've converted it to an activeX control for use in the main program.

Thank's once again,

Michael Zwijacz

 

[vb5prgrmr]

That is why the error handler is the way it is. If there is an error in the lookup it returns false. If there is no error then the image was found. You can also write the function like ...
[tt]
Private Function DoesImageExist(strKey As String) As Boolean

On Error GoTo DoesImageExistError

Dim LI As ListImage

Set LI = IL.ListImages(strKey)

DoesImageExist = True

DoesImageExistError:

Set LI = Nothing

End Function
[/tt]

Good Luck