[VB6] ucShellTree - Full-featured Shell Tree UserControl

[fafalone]

Ok I found I solution for the default share/link ones. I don't know if this is how I was doing it during tests the other week but it's working now. Replace the InitImageLists function with this one:

Private Sub InitImageLists()
    If IsComCtl6 = False Then
        himlTV = ImageList_Create(mIconSize, mIconSize, ILC_COLOR32 Or ILC_MASK, 1, 1)
        Dim clbk As Long
        OleTranslateColor clrBack, 0&, clbk
        ImageList_SetBkColor himlTV, clbk
    Else
        himlTV = ImageList_Create(mIconSize, mIconSize, ILC_COLOR32 Or ILC_MASK Or ILC_HIGHQUALITYSCALE, 1, 1)
    End If
    Call SHGetImageList(SHIL_JUMBO, IID_IImageList, imlSysJM)
    hSysIL = ObjPtr(imlSysJM)
End Sub

Also make the first line of EnsureOverlay
If nIdx = -1 Then Exit Function

Shouldn't be letting it raise an error.

Haven't looked into the extended ones crashing yet. I stopped using them myself because, at least on my last Windows install, retrieving them was *painfully* slow. Like 10x the execution time slow.

[Mith]

Ok I found I solution for the default share/link ones. I don't know if this is how I was doing it during tests the other week but it's working now. Replace the InitImageLists function with this one:

The overlay icons are displayed again with the code changes BUT they are very tiny now:



Windows Explorer:

[fafalone]

Yeah that's a combination of DPI and custom resolution support issues; if you're dpi aware, turn it off so the system does it; that generally works better. Choosing a different icon size will help too.

Like in my DPI-unaware test app, they look like this, with the default icon size of 24:

[Mith]

Yeah that's a combination of DPI and custom resolution support issues; if you're dpi aware, turn it off so the system does it; that generally works better. Choosing a different icon size will help too.

My apps are not DPI-aware too.

I tested v2.7 and 2.9.2 with Win10 using a System-DPI scale of 150% and a ShellTree icon size of 16px:



The overlay icon with v2.7 looks correct and clearly visible. The arrow stays in a checkbox with a white background.

The overlay icon since 2.9 looks like a part of the old overlay icon and zoomed in:



Can you check this in your code? There must be something wrong.

[fafalone]

Maybe try ILD_SCALE and/or ILD_DPISCALE as additional flags in EnsureOverlay->imlSysJM.GetIcon nOvr, ILD_TRANSPARENT, hIcon

If that doesn't help, the only remedy would be a lot of fragile manual sizing that would likely then wind up looking wrong on other people's systems.

[Mith]

Maybe try ILD_SCALE and/or ILD_DPISCALE as additional flags in EnsureOverlay->imlSysJM.GetIcon nOvr, ILD_TRANSPARENT, hIcon
If that doesn't help, the only remedy would be a lot of fragile manual sizing that would likely then wind up looking wrong on other people's systems.

I fixed the overlay icon size problem in your code:

At Sub "InitImageLists" change:

Call SHGetImageList(SHIL_JUMBO, IID_IImageList, imlSysJM)

back to:

Call SHGetImageList(SHIL_SMALL, IID_IImageList, imlSysJM)

But this will break icon size property. A icons size >16 is not possible anymore.
I guess you have to use a separate ImageList for the overlay icons because they only use 16x16.

[fafalone]

Well yeah if you shrink the icons the overlay will appear larger relative to them. The real question is why the overlay isn't scaling like the icons.

So IconSize still works with your suggestion for me using a separate ImageList; but I never had the issue with them being too small. See if it works with the following changes, if so, it will be put into the release:

To module level declares, add: Private imlSysSM As IImageList
To InitImageLists, add: Call SHGetImageList(SHIL_SMALL, IID_IImageList, imlSysSM) (and revert JM back to JUMBO)

Change EnsureOverlay to:

Private Function EnsureOverlay(nIdx As Long) As Long
    If nIdx = -1 Then Exit Sub
    
    If bOvrAdded(nIdx) Then EnsureOverlay = 1: Exit Function
    
    Dim nOvr As Long
    Dim hIcon As LongPtr
    Dim nPos As Long
    imlSysSM.GetOverlayImage nIdx, nOvr
    If nOvr >= 0 Then
        imlSysSM.GetIcon nOvr, ILD_TRANSPARENT, hIcon
        nPos = ImageList_AddIcon(himlTV, hIcon)
        Call DestroyIcon(hIcon)
        ImageList_SetOverlayImage himlTV, nPos, nIdx
        bOvrAdded(nIdx) = True
    End If
End Function

[Mith]

FIXED: I added the changes and now the overlay icons are looking normal using IconSize=16!

I just want to let you know about another issue with the IconSize property:

You should remove "Public Property Let IconSize(cxy As Long)" because you mess up the tree if you, for example, set the ShellTree control to a standard IconSize value of 32px and in the form_load event you set ucTree.IconSize=16...or visa versa

[Mith]

For a multiple file selection dialog i want to hide the checkboxes for non-files like you do with mRootHasCheckbox for the root only.

I think about a property like ShowOnlyFileCheckboxes.

For example:

if bFolder = true and checkboxes = true and showfiles = true and ShowOnlyFileCheckboxes = true then
    TreeView_SetCheckStateEx hTVD, hitem, 0 ' no checkbox for non-filees
endif

[Mith]

I added the property ShowOnlyFileCheckbox and at TVExpandFolder i changed

If bFav Then
   TreeView_SetCheckStateEx hTVD, hitemPrev, 0
Else

to

If bFav Or (bFolder = True And mShowOnlyFileCheckbox = True) Then
   TreeView_SetCheckStateEx hTVD, hitemPrev, 0
Else

and it works for expand items but not for the root enum:



Where can i change the checkbox state for the root enum items?

[fafalone]

RootHasCheckbox property already exists; is it not working?

[Mith]

RootHasCheckbox property already exists; is it not working?

No, it's set to false but still show the checkboxes.

Reason:

I have to set the control property ShowCheckboxes=True.

If the control property ShowCheckboxes is set to False and i set .ShowCheckboxes =True in the code it doesnt work....

[Mith]

How can i init all the control properties in the form_load or form_activate event before the treeview is created?

I set them in the code and after i used RefreshTreeView, ResetTreeView and HardResetTreeView but nothing works.

btw, with HardResetTreeView i get an empty control window.

[fafalone]

You can't... would have to do it in the designer.

I'm confused about your picture; how are there so many root nodes? If Desktop is the root, This PC shouldn't show on the same level; if This PC is the root, the Network and a couple other things shouldn't show. I can't reproduce the issue with my normal root setup with either ComputerAsRoot = True or False.

[Mith]

I fixed the RootHasCheckbox problem in ucWndProc -> TVN_ITEMCHANGINGW

Before:

            Case TVN_ITEMCHANGINGW
                If (bFilling = False) And (g_fDeleting = False) And (mAutocheck = True) Then
                   .....
                End If

After:

Case TVN_ITEMCHANGINGW
   If (bFilling = False) And (g_fDeleting = False) And (mAutocheck = True) Then
      .....
   ElseIf (bFilling = False) And (g_fDeleting = False) Then
         'MITH
        Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
        tvix.Mask = TVIF_STATEEX
        tvix.hItem = nmtvic.hItem
        Call SendMessage(hTVDW, TVM_GETITEM, 0, tvix)
        If (nmtvic.hItem = m_hRoot) And (mRootHasCheckbox = False) Then
            lReturn = 1
            bHandled = True
            Exit Sub
        End If
        idx = GetTVItemlParam(hTVD, nmtvic.hItem)
        tNew = TVEntries(idx)
        If (tNew.bFolder = True And mShowOnlyFileCheckbox = True And mShowFiles = True) Then
            lReturn = 1
            bHandled = True
            Exit Sub
        End If
    End If

New code for property ShowOnlyFileCheckbox:

Private mShowOnlyFileCheckbox As Boolean
Private Const mShowOnlyFileCheckbox_def As Boolean = False

Public Property Get ShowOnlyFileCheckbox() As Boolean: ShowOnlyFileCheckbox = mShowOnlyFileCheckbox: End Property
Public Property Let ShowOnlyFileCheckbox(bVal As Boolean)
   mShowOnlyFileCheckbox = bVal
End Property

Private Sub UserControl_ReadProperties(propBag As PropertyBag)
mShowOnlyFileCheckbox = propBag.ReadProperty("ShowOnlyFileCheckbox", mShowOnlyFileCheckbox_def)
End Sub
Private Sub UserControl_WriteProperties(propBag As PropertyBag)
propBag.WriteProperty "ShowOnlyFileCheckbox", mShowOnlyFileCheckbox, mShowOnlyFileCheckbox_def
End Sub
Private Sub UserControl_InitProperties()
mShowOnlyFileCheckbox = mShowOnlyFileCheckbox_def
End Sub

Private Sub TVExpandFolder(lParam As Long, hitemParent As Long)
        .....
	If bFav Or (bFolder = True And mShowOnlyFileCheckbox = True And mShowFiles = True) Then 'Mith
	    TreeView_SetCheckStateEx hTVD, hitemPrev, 0
	Else
	    If TreeView_GetCheckState(hTVD, hitemParent) = 2 Then
	       If mAutocheck = True Then
	        TreeView_SetCheckState hTVD, hitemPrev, 1
	       End If
	    End If
	End If
	.....
End Sub

[Mith]

Finally everything works & look fine for me!

Let me know if you want the "forked" ShellTTree CTL.

Sreenshots are taken in a WMware using Win10x64 Home german.

multi file selection only file checkboxes visible:



multi folder selection:



custom root multi file selection:

[Mith]

Im testing the control now with Windows 11 and i found somes issues:

Using FileExtensions = Always_Show still not display many file extensions: .exe, .zip, .chm, .url, .msg, .txt, ...
At Win10 they are visible except ".url".

mNeverExpandZip = True
FileExtensions = Always_Show
CheckBoxes=True

TVAddItem:

        siChild.GetDisplayName SIGDN_NORMALDISPLAY, lpName
        sName = LPWSTRtoStr(lpName)
        If m_ForceExt = STEP_AlwaysShow Then
            siChild.GetDisplayName SIGDN_NORMALDISPLAY, lpNameFull
            sNameFull = LPWSTRtoStr(lpNameFull)

Above you use the same flag when u force the the full file name. Is this correct?


2. The Desktop item in the sub-tree doesnt show all files/folders on the desktop (Win10+11):

Screenshot Win10

[Mith]

Im testing the control now with Windows 11 and i found somes issues:

Using FileExtensions = Always_Show still not display many file extensions: .exe, .zip, .chm, .url, .msg, .txt, ...
At Win10 they are visible except ".url".

Bug fixed. All file extensions are now displayed!

Changes must be made at TVAddItem & TVExpandFolder:

Before:

If m_ForceExt = STEP_AlwaysShow Then
   siChild.GetDisplayName SIGDN_NORMALDISPLAY, lpNameFull

After

If m_ForceExt = STEP_AlwaysShow And bFolder = False Then
   siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull

and the follwing code must be executed before the above code changes because of the possible change of the variable bFolder:

                     
If (mShowFiles = True) And (mExpandZip = False) Then
    If (bFolder = True) And (bZip = True) Then
       bFolder = False
    End If
End If

[jdelano]

Very cool to see two super devs working in concert. Bravo! Now I want to create an app to use this control

[fafalone]

1) Definite typo with the always show, thanks. .url still might not show because it's a "never show" extension like .lnk. If it is showing; is .lnk showing? Can't have .lnk showing.

2) I'm still not understanding how you're seeing so many root nodes on the same level; I'll test the change you suggested to make sure it doesn't break anything on my end but I'd really prefer to understand the issue there; there should only be 1 or 2 root nodes.

3) I can't reproduce the issue with items not showing. Can you turn on the debug log and post what it outputs on startup?

4) I've been keeping up with your changes on my end, it's very much appreciated I'll have a big thanks for you in the next release.

[Mith]

1) Definite typo with the always show, thanks. .url still might not show because it's a "never show" extension like .lnk. If it is showing; is .lnk showing? Can't have .lnk showing.

Now it shows ALL file extensions. For me it is ok, because i only use the control for single/multi file/folder selection but i guess we need another variable to not show the extension for LNK-files.

2) I'm still not understanding how you're seeing so many root nodes on the same level; I'll test the change you suggested to make sure it doesn't break anything on my end but I'd really prefer to understand the issue there; there should only be 1 or 2 root nodes.

I tested the control with a german Win10 Home on VMware.

3) I can't reproduce the issue with items not showing. Can you turn on the debug log and post what it outputs on startup?

It's already fixed. I used a older version while testing :-|

4) I've been keeping up with your changes on my end, it's very much appreciated I'll have a big thanks for you in the next release.

I've already added more features:

' - Added property ShowOnlyDrives. Shows only drives when ComputerAsRoot=True and
'   deactivates expanding of drives

' - Added property HideRecycleBin. hides the recycle bin
' - Added property HideControlPanel. hides the Control Panel
' - Added property HideOneDrive. hides OneDrive
' - Added property HideNetwork. hides Network
' - Added property HideLibraries. hides Libraries

[Mith]

Bug report for MonitorDirChanges=True:

The control is updated when i delete a file/folder on the desktop BUT not if i add a new file/folder on the desktop.

Tested with v2.7/2.9.x

[Mith]

I added the project variable mHideLNKfileExtension to hide/unhide the LNK extension.

Private Const mHideLNKfileExtension As Boolean = True

Code change in HandleShellNotify, TVAddItem & TVExpandFolder:

        If m_ForceExt = STEP_AlwaysShow And bFolder = False Then
            siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull 'mith - fix for correct display name
            sNameFull = LPWSTRtoStr(lpNameFull)
            If Right(LCase(sNameFull), 4) = ".lnk" And mHideLNKfileExtension = False Then
            If Left$(sNameFull, 3) <> "::{" Then
            If Left$(sNameFull, 5) <> "uuid:" Then
            If Left$(sNameFull, 7) <> "usb#vid" Then
            If Left$(sNameFull, 9) <> "Provider\" Then 'mith - fix for win7 Network
            If InStr(sNameFull, "\?\usb#") = 0 Then
                sName = sNameFull
            End If
            End If
            End If
            End If
            End If
            End If
        End If

Above you also see another fix for the Win7 Network folder.

[Mith]

mHideLNKfileExtension=True

Looks good with Windows 11:

[Mith]

Code changes for the property ShowOnlyDrives:

Private mShowOnlyDrives As Boolean
Private Const mShowOnlyDrives_def As Boolean = False

'UserControl_ReadProperties
mShowOnlyDrives = propBag.ReadProperty("ShowOnlyDrives", mShowOnlyDrives_def)

'UserControl_WriteProperties
propBag.WriteProperty "ShowOnlyDrives", mShowOnlyDrives, mShowOnlyDrives_def

'UserControl_InitProperties
mShowOnlyDrives = mShowOnlyDrives_def

Public Property Get ShowOnlyDrives() As Boolean: ShowOnlyDrives = mShowOnlyDrives: End Property
Public Property Let ShowOnlyDrives(bVal As Boolean)
mShowOnlyDrives = bVal
End Property

TVExpandFolder before:

                    siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                    sNameFull = LPWSTRtoStr(lpNameFull)
                    If (m_HiddenPref = STHP_UseExplorer) Then

change to:

                    siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                    sNameFull = LPWSTRtoStr(lpNameFull)
                     If mComputerAsRoot = True And mShowOnlyDrives = True Then
                        If Left(sNameFull, 3) = "::{" Then GoTo nxt
                     End If
                    If (m_HiddenPref = STHP_UseExplorer) Then

[Mith]

Code changes for the new properties:

HideRecycleBin
HideControlPanel
HideOneDrive
HideNetwork
HideLibraries

Private mHideRecycleBin As Boolean
Private Const mHideRecycleBin_def As Boolean = False

Private mHideControlPanel As Boolean
Private Const mHideControlPanel_def As Boolean = False

Private mHideOneDrive As Boolean
Private Const mHideOneDrive_def As Boolean = False

Private mHideNetwork As Boolean
Private Const mHideNetwork_def As Boolean = False

Private mHideLibraries As Boolean
Private Const mHideLibraries_def As Boolean = False

'UserControl_ReadProperties
        mHideRecycleBin = propBag.ReadProperty("HideRecycleBin", mHideRecycleBin_def)
        mHideControlPanel = propBag.ReadProperty("HideControlPanel", mHideControlPanel_def)
        mHideOneDrive = propBag.ReadProperty("HideOneDrive", mHideOneDrive_def)
        mHideNetwork = propBag.ReadProperty("HideNetwork", mHideNetwork_def)
        mHideLibraries = propBag.ReadProperty("HideLibraries", mHideLibraries_def)

'UserControl_WriteProperties
   propBag.WriteProperty "HideRecycleBin", mHideRecycleBin, mHideRecycleBin_def
   propBag.WriteProperty "HideControlPanel", mHideControlPanel, mHideControlPanel_def
   propBag.WriteProperty "HideOneDrive", mHideOneDrive, mHideOneDrive_def
   propBag.WriteProperty "HideNetwork", mHideNetwork, mHideNetwork_def
   propBag.WriteProperty "HideLibraries", mHideLibraries, mHideLibraries_def

'UserControl_InitProperties
    mHideRecycleBin = mHideRecycleBin_def
    mHideControlPanel = mHideControlPanel_def
    mHideOneDrive = mHideOneDrive_def
    mHideNetwork = mHideNetwork_def
    mHideLibraries = mHideLibraries_def

Public Property Get HideRecycleBin() As Boolean: HideRecycleBin = mHideRecycleBin: End Property
Public Property Let HideRecycleBin(bVal As Boolean)
mHideRecycleBin = bVal
End Property
Public Property Get HideControlPanel() As Boolean: HideControlPanel = mHideControlPanel: End Property
Public Property Let HideControlPanel(bVal As Boolean)
mHideControlPanel = bVal
End Property
Public Property Get HideOneDrive() As Boolean: HideOneDrive = mHideOneDrive: End Property
Public Property Let HideOneDrive(bVal As Boolean)
mHideOneDrive = bVal
End Property
Public Property Get HideNetwork() As Boolean: HideNetwork = mHideNetwork: End Property
Public Property Let HideNetwork(bVal As Boolean)
mHideNetwork = bVal
End Property
Public Property Get HideLibraries() As Boolean: HideLibraries = mHideLibraries: End Property
Public Property Let HideLibraries(bVal As Boolean)
mHideLibraries = bVal
End Property

TVExpandFolder before:

                    siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                    sNameFull = LPWSTRtoStr(lpNameFull)
                    If (m_HiddenPref = STHP_UseExplorer) Then

After:

                    siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                    sNameFull = LPWSTRtoStr(lpNameFull)

                     If mHideControlPanel = True Then ' Mith
                        If sNameFull = "::{26EE0668-A00A-44D7-9371-BEB064C98683}" Then GoTo nxt
                        If sNameFull = "::{5399E694-6CE5-4D6C-8FCE-1D8870FDCBA0}" Then GoTo nxt
                     End If
                     If mHideRecycleBin = True Then ' Mith
                        If sNameFull = "::{645FF040-5081-101B-9F08-00AA002F954E}" Then GoTo nxt
                     End If
                     If mHideOneDrive = True Then ' Mith
                        If sNameFull = "::{018D5C66-4533-4307-9B53-224DE2ED1FE6}" Then GoTo nxt
                     End If
                     If mHideNetwork = True Then ' Mith
                        If sNameFull = "::{F02C1A0D-BE21-4350-88B0-7367FC96EF3C}" Then GoTo nxt
                     End If
                     If mHideLibraries = True Then ' Mith
                        If sNameFull = "::{031E4825-7B94-4DC3-B131-E946B44C8DD5}" Then GoTo nxt
                     End If

                    If (m_HiddenPref = STHP_UseExplorer) Then

[Mith]

I fixed another issue:

Currently you can't set up the control properties before the ShellTree is created.

Solution:

I added the project variable mCreateShellTreeManually and the public function "Create_ShellTree":

' - Added project variable mCreateShellTreeManually.
'    True = you have to call the new public function "Create_ShellTree" to create the ShellTree.
'           This enables you to set up all control properties in the code before the ShellTree
'           is created. Also avoids the enum of the ShellTree with the standard properties!
'    False = ShellTree will be created automatically after reading the usercontrol properties

Private Const mCreateShellTreeManually As Boolean = False

Public Sub Create_ShellTree()
   If mCreateShellTreeManually = True Then
      pvCreate
   End If
End Sub

Necessary code changes:

Private Sub UserControl_ReadProperties(propBag As PropertyBag)
    If mCreateShellTreeManually = False Then pvCreate
End Sub

Private Sub UserControl_InitProperties()
    if mCreateShellTreeManually = False Then pvCreate
End Sub

Advantages:

- you can set up the control properties before the ShellTree is created
- the initial enumeration of the ShellTree content runs only once!
- some control properties couldnt be changed after the Shelltree was created, e.g. checkboxes

Example:

'ShellTree CTL code:

mCreateShellTreeManually = True

' your form:

Private Sub Form_Load()

   ucTree.Autocheck = False
   ucTree.BorderStyle = STBS_None
   ucTree.DisableDragDrop = True
   ucTree.EnableShellMenu = False
   ucTree.ExclusionChecks = False
   ucTree.ExpandZip = False
   ucTree.InfoTipOnFiles = False
   ucTree.LabelEditRename = False
   ucTree.PlayNavigationSound = False
   ucTree.ShowFavorites = False
   ucTree.ShowHiddenItems = STHP_AlwaysShow
   ucTree.ShowSuperHidden = STSHP_AlwaysShow
   ucTree.SingleClickExpand = True
   ucTree.AutoExpandLibraries = False
   ucTree.AutoExpandComputer = False
   ucTree.DisableWow64Redirect = False
   ucTree.FileExtensions = STEP_AlwaysShow
   ucTree.ShowQuickAccessOnWin10 = False
   ucTree.ShowOnlyFileCheckbox = True
   ucTree.ComputerAsRoot = False
   
   Call ucTree.Create_ShellTree

End Sub

[Mith]

I fixed the RootHasCheckbox problem in ucWndProc -> TVN_ITEMCHANGINGW

Before:

            Case TVN_ITEMCHANGINGW
                If (bFilling = False) And (g_fDeleting = False) And (mAutocheck = True) Then
                   .....
                End If

After:

Case TVN_ITEMCHANGINGW
   If (bFilling = False) And (g_fDeleting = False) And (mAutocheck = True) Then
      .....
   ElseIf (bFilling = False) And (g_fDeleting = False) Then
         'MITH
        Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
        tvix.Mask = TVIF_STATEEX
        tvix.hItem = nmtvic.hItem
        Call SendMessage(hTVDW, TVM_GETITEM, 0, tvix)
        If (nmtvic.hItem = m_hRoot) And (mRootHasCheckbox = False) Then
            lReturn = 1
            bHandled = True
            Exit Sub
        End If
        idx = GetTVItemlParam(hTVD, nmtvic.hItem)
        tNew = TVEntries(idx)
        If (tNew.bFolder = True And mShowOnlyFileCheckbox = True And mShowFiles = True) Then
            lReturn = 1
            bHandled = True
            Exit Sub
        End If
    End If

I found a bug in my code changes. I copied and paste to much of your code

The correct changes are:

Case TVN_ITEMCHANGINGW
   If (bFilling = False) And (g_fDeleting = False) And (mAutocheck = True) Then
      .....
   ElseIf (bFilling = False) And (g_fDeleting = False) Then
         'MITH
        Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
        idx = GetTVItemlParam(hTVD, nmtvic.hItem)
        tNew = TVEntries(idx)
        If (tNew.bFolder = True And mShowOnlyFileCheckbox = True And mShowFiles = True) Then
            lReturn = 1
            bHandled = True
            Exit Sub
        End If
    End If

[fafalone]

I fixed another issue:

Currently you can't set up the control properties before the ShellTree is created.

Solution:

I added the project variable mCreateShellTreeManually and the public function "Create_ShellTree":

I'm curious, why this over the designer?

[Mith]

I'm curious, why this over the designer?

1. You can set up the control properties before the ShellTree is created for different display scenarios.

2. It's fast because when i set .CustomRoot ="C:\test" for example the control doesnt start the enumeration for the Desktop first.

3. Some control properties couldnt be changed after the Shelltree was created, e.g. checkboxes.

MSDN (https://learn.microsoft.com/en-us/wi...ended-styles):

The tree-view control has a very specific behavior for the checkbox styles. When a specific style or 'EX'-style combination is activated, the control keeps it to the end of its life (which means that you cannot modify the first checkbox style during the life of tree-view control).

4. Sometimes you have to remove and redrop the control on the form and all your property settings are lost

...

[fafalone]

1/4 make sense... I'll include that in release too (and probably add that ability to ucShellBrowse too).

(2/3 are the same with the designer; it won't load desktop if custom root is set and you can set Checkboxes)


Though I might look into why you can only call pvCreate once. This need is seemingly brought on by this not working:

DestroyWindow hTVD
pvCreate

If that worked you could change settings during runtime too.


PS- I definitely appreciate all the love you're giving this project; I've got so many other interesting projects I've neglected substantially upgrading this one for a while.

[Mith]

I added the project variable mHideLNKfileExtension to hide/unhide the LNK extension.

Private Const mHideLNKfileExtension As Boolean = True

Code change in HandleShellNotify, TVAddItem & TVExpandFolder:

        If m_ForceExt = STEP_AlwaysShow And bFolder = False Then
            siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull 'mith - fix for correct display name
            sNameFull = LPWSTRtoStr(lpNameFull)
            If Right(LCase(sNameFull), 4) = ".lnk" And mHideLNKfileExtension = False Then
            If Left$(sNameFull, 3) <> "::{" Then
            If Left$(sNameFull, 5) <> "uuid:" Then
            If Left$(sNameFull, 7) <> "usb#vid" Then
            If Left$(sNameFull, 9) <> "Provider\" Then 'mith - fix for win7 Network
            If InStr(sNameFull, "\?\usb#") = 0 Then
                sName = sNameFull
            End If
            End If
            End If
            End If
            End If
            End If
        End If

Above you also see another fix for the Win7 Network folder.

Bugfix for the code above:

If Right(LCase(sNameFull), 4) = ".lnk" Then
   If mHideLNKfileExtension = False Then
      sName = sNameFull
   End If
ElseIf Left$(sNameFull, 3) <> "::{" Then
If Left$(sNameFull, 5) <> "uuid:" Then
If Left$(sNameFull, 7) <> "usb#vid" Then
If Left$(sNameFull, 9) <> "Provider\" Then 'mith fix for win7 Network
If InStr(sNameFull, "\?\usb#") = 0 Then
    sName = sNameFull
End If
End If
End If
End If
End If

[Mith]

Win10x64

I want to select the system file "manage-bde.exe" with the ShellTree control but i cant find it anywhere.

The location of the file manage-bde.exe is "C:\windows\system32\manage-bde.exe".

See Windows Explorer:



The file above is a hard link from "C:\Windows\WinSxS\amd64_microsoft-windows-securestartup-tool-exe_31bf3856ad364e35_10.0.19041.1_none_b00bcb3b56b3d8e3\manage-bde.exe"

The open secret for 32-bit apps:

whenever a 32-bit application attempts to access %windir%\System32, the access is redirected to %windir%\SysWOW64

But i can't find the file inside SysWOW64 too.

I tried your new control property DisableWow64Redir but i still cant find the file in folder "C:\windows\system32".

I also used Wow64DisableWow64FsRedirection outside in my form code before i show the control but still no luck to find this file.

Please can you try this on your computer? Any ideas whats going on here?

[Mith]

Win8.1

I tried to open the path "C:\Users\adminENG\AppData\Local\Temp" but ShellControl doesnt do it because the folder "AppData" is hidden. ShowHiddenItems & ShowSuperHidden are set to "1 - STHP_AlwaysShow":



I can open the path with Windows Explorer but the folder is not visible in the left tree:



Any ideas why ShellControl doesnt show hidden folders inside the User-folder?

[VanGoghGaming]

Just tested this and it works:

Debug.Print FileExists("C:\Windows\System32\manage-bde.exe")
' Output: False

Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32" (OldValue As Long) As Long
Private Declare Function Wow64RevertWow64FsRedirection Lib "kernel32" (ByVal OldValue As Long) As Long

    Dim OldValue As Long
    If Wow64DisableWow64FsRedirection(OldValue) Then
        Debug.Print FileExists("C:\Windows\System32\manage-bde.exe")
        Wow64RevertWow64FsRedirection OldValue
    End If
' Output: True

You can replace the "FileExists" function above with any other file access function you want.

Public Function FileExists(sPath As String, Optional bFolderExists As Boolean, Optional bDeleteFileOrFolder As Boolean) As Boolean
Dim lAttributes As Long
    lAttributes = GetFileAttributesW(StrPtr(sPath))
    If lAttributes <> INVALID_HANDLE_VALUE Then
        If bFolderExists Then
            FileExists = (lAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
            If FileExists Then If bDeleteFileOrFolder Then bDeleteFileOrFolder = RemoveDirectoryW(StrPtr(sPath))
        Else
            FileExists = (lAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY
            If FileExists Then If bDeleteFileOrFolder Then bDeleteFileOrFolder = DeleteFileW(StrPtr(sPath))
        End If
    End If
End Function

[Mith]

Just tested this and it works: ...

The ShellControl doesnt uses file APIs to enumerate files and folder...it uses Shell-APIs to enumerate, e.g.:

Dim pKFM As oleexp.KnownFolderManager
Dim pkf As oleexp.IKnownFolder
Dim siFav As oleexp.IShellItem

I guess Wow64DisableWow64FsRedirection has no effect using Shell-APIs.

[VanGoghGaming]

I was just trying to point out that "Wow64DisableWow64FsRedirection" is successful in disabling the redirection. It shouldn't matter how you access the files.

The documentation does say to pair "Wow64DisableWow64FsRedirection" with "Wow64RevertWow64FsRedirection" when you're done.

[fafalone]

ucShellTree already has a .DisableWow64Redirect option. I checked, it works as expected, my enumeration of System32 shows the SysWOW64 contents when the option is disabled, but the real System32 contents when enabled.

[Mith]

ucShellTree already has a .DisableWow64Redirect option. I checked, it works as expected, my enumeration of System32 shows the SysWOW64 contents when the option is disabled, but the real System32 contents when enabled.

Do you see the file manage-bde.exe in the folder system32 or SysWOW64 in the ucShellTree?

[fafalone]

System32 if .DisableWow64Redirect = True, otherwise don't see it in either because it's only in System32.

Bug: Disabling of Wow64 redirection wasn't reverted on terminate.
Fix: Add If m_NoWow64 Then RevertWow64Redir() to UserControl_Terminate

This would leave redirection disable = true if you set it through multiple runs if running from the IDE after you changed it back to False.