Confirmed. These changes resolve the Tri-State-Bug when setting .Checkboxes = True in the code (control properties: Autocheck=false, Checkboxes=false, ExclusionChecks=false)
Printable View
Sorry, but i found another bug :-)
control properties:
Form_Load:Code:Autocheck=false
Checkboxes=True
ExclusionChecks=false
MSDN TVS_CHECKBOXES Description:Code:ucTree.Checkboxes = False
You have to rebuild the treeview again in the "Public Property Let Checkboxes" if set to FALSE. Destroy the TV and call "InitTV" again?Quote:
Once a tree-view control is created with this style, the style cannot be removed. Instead, you must destroy the control and create a new one in its place.
i found some more bugs while testing the control:
1. ExpandZip is set to false but the zip file stills expands.
2. ItemClick event: the variable bFolder returns True if i click on a ZIP file.
control properties:
Code:ExpandZip=false
ShowFiles=True
Autocheck=false
Checkboxes=false
ExclusionChecks=false
Fix:
Func "ucWndProc", Case NM_CLICK, Case NM_RCLICK
Now the variable bFolder returns False for ZIP files.Code:Dim b_isFolder As Boolean
If TVEntries(tVI.lParam).bZip = True Then
b_isFolder = False
Else
b_isFolder = TVEntries(tVI.lParam).bFolder
End If
RaiseEvent ItemClick(TVEntries(tVI.lParam).sName, TVEntries(tVI.lParam).sFullPath, b_isFolder, MK_LBUTTON, tvhti.hItem)
RaiseEvent ItemClickByShellItem(siSelected, TVEntries(tVI.lParam).sName, TVEntries(tVI.lParam).sFullPath, b_isFolder, MK_LBUTTON, tvhti.hItem)
No need to apologize for bug reports-- I'm sorry they're needed, but I definitely want to get them so I can fix it.
--
Post 82-- Try .RefreshTreeView() after changing the check; that destroys and recreates-- I spent tons of time working out how to restore the expansion states of the filesystem too, so it won't go back to startup state (if you want that, .ResetTreeView). I'll add in routine to this automatically if transitioning from checked to unchecked.
Post 83-- If ShowFiles = False, I can't reproduce this-- it correctly excludes zip files. If ShowFiles = True, then it's by design-- perhaps it's not the best name; ExpandZip is more along the lines of 'treat zip as folder'; I hadn't set it up to treat a zip as a file but block expansion anyway.
Post 84 - This is the same design issue. If ExpandZip is True, a zip *should be* reported as a folder (as Explorer does). I'll modify that block to check that setting, but it will still return bFolder = True when ExpandZip = True.
---
Actually, try this:
In TVAddItem, prior to TVEntries(nCur).sFullPath = sFPP, add this block:
Also add that in TVExpandFolder, just before TVEntries(nCur).sFullPath = LPWSTRtoStr(lpFull)Code:If (mShowFiles = True) And (mExpandZip = False) Then
If (bFolder = True) And (bZip = True) Then
bFolder = False
End If
End If
That should resolve issues globally instead of just at the click spot, because it impacts drag/drop too.
Event bug:
You only raise the event "ItemCheck" if Autocheck=True. See unWndProc -> TVN_ITEMCHANGEDW.
The event "ItemCheck" should also raised if AutoCheck=False.
Fix:
Add this line:
to ucWndProc -> TVN_ITEMCHANGEDWCode:RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, CLng(Abs(TVEntries(nmtvic.lParam).Checked)), nmtvic.hItem)
What about &H3000 and &H4000?Code:If (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H1000 Then
TVEntries(nmtvic.lParam).Checked = False
TVEntries(nmtvic.lParam).Excluded = False
RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, CLng(Abs(TVEntries(nmtvic.lParam).Checked)), nmtvic.hItem)
ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H2000 Then
TVEntries(nmtvic.lParam).Checked = True
TVEntries(nmtvic.lParam).Excluded = False
RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, CLng(Abs(TVEntries(nmtvic.lParam).Checked)), nmtvic.hItem)
ucTree Enhancement "ShowOnlyFileCheckboxes"
Situation:
A user should select some files via checkboxes but not select any folders via the checkboxes.
Solution:
A solution could be to show checkboxes only for files using a control property like "ShowOnlyFileCheckboxes".
Current solution:
Currently i modified the ItemCheck event to respond to changes of the variable fCheck to change back the Check-State if necessary:
Code:ucWndProc -> TVN_ITEMCHANGEDW
If (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H1000 Then
TVEntries(nmtvic.lParam).Checked = False
TVEntries(nmtvic.lParam).Excluded = False
i = CLng(Abs(TVEntries(nmtvic.lParam).Checked))
lSel = i
RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, lSel, nmtvic.hItem)
If lSel <> i Then
TVEntries(nmtvic.lParam).Checked = True
SetTVItemStateImage nmtvic.hItem, tvcsChecked
End If
ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H2000 Then
DebugAppend "ItemCheck"
TVEntries(nmtvic.lParam).Checked = True
TVEntries(nmtvic.lParam).Excluded = False
i = CLng(Abs(TVEntries(nmtvic.lParam).Checked))
lSel = i
RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, lSel, nmtvic.hItem)
If lSel <> i Then
TVEntries(nmtvic.lParam).Checked = False
SetTVItemStateImage nmtvic.hItem, tvcsEmpty
End If
What do you think?Code:Private Sub ucFiles_ItemCheck(sName As String, sFullPath As String, bFolder As Boolean, fCheck As Long, hItem As Long)
If bFolder = True And fCheck = 1 Then
fCheck = 0 ' dont allow check folders & others
End If
End Sub
Try this:
Code:Public Sub HardResetTreeView()
If Ambient.UserMode Then
DestroyWindow hTVD
pvCreate
End If
End Sub
Public Sub HardRefreshTreeView()
'Resets to the root then expands all the previous locations
'The lengthy code involves minimizing the OpenToPath calls by calculating
'smallest group of folders that will give us the same setup. E.g.:
'C:\a\b\(c,d,e,f) will call only C:\a\b\c, and not d,e,f or C:\a or b, because
'expanding to c will give us a b d e and f too
Dim i As Long
Dim sData() As String
If CalcRefreshData(sData) Then
HardResetTreeView
For i = 0 To UBound(sData)
OpenToPath sData(i), False
Next i
End If
OpenToPath sSelectedItem, False, True
Exit Sub
e0:
DebugAppend "PruneParentsFromRPL.Error->" & Err.Description & "(0x" & Hex$(Err.Number) & ")"
End Sub
Good catch-- I think you should have it *only* at the spots your fix puts, otherwise it would fire twice when AutoCheck = True. Will include in next release, thanks.Quote:
You only raise the event "ItemCheck" if Autocheck=True. See unWndProc -> TVN_ITEMCHANGEDW.
The event "ItemCheck" should also raised if AutoCheck=False.
&H3000 and &H4000 are partial check and exclusion check; they shouldn't raise a check event. Perhaps a new event should be added for ItemExclude, but it really shouldn't be a check event.
You're of course welcome to modify ucShellTree but I think that's going a little beyond scope-- you'd be better off pairing a ucShellTree with ucShellBrowse; you could set the latter to turn off the top bar, hide folders, and show checkboxes, with the folder tree to the side for navigation.Quote:
A user should select some files via checkboxes but not select any folders via the checkboxes.
Like this, but with Checkboxes = True for the ucShellBrowse control:
Attachment 190188
I added a useful helper function to the control:
This helps to decide e.g. to enabled or disabled a OK-button on a dialog window.Code:Public Property Get CheckedPathCount() As Variant
CheckedPathCount = GetCheckedPathCount
End Property
Private Function GetCheckedPathCount() As Long
Dim i As Long
Dim lCount As Long
lCount = 0
For i = 0 To UBound(TVEntries)
If (TVEntries(i).Checked = True) And (TVEntries(i).bDeleted = False) Then
lCount = lCount + 1
End If
Next i
GetCheckedPathCount = lCount
End Function
Do you have any explanation why i can't return a LONG with this helper function? The control crahses when i return a LONG...
How about to add this before the event-raise for check/uncheck?
Code:if AutoCheck = false then
i = CLng(Abs(TVEntries(nmtvic.lParam).Checked))
lSel = i
RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, lSel, nmtvic.hItem)
If lSel <> i Then
TVEntries(nmtvic.lParam).Checked = True
SetTVItemStateImage nmtvic.hItem, tvcsChecked
End If
end if
I found another bug:
The change of the control property BorderStyle isnt stored because at UserControl_ReadProperties you read the property with the name "Border" but you save the property with the name "BorderStyle".
Easy to fix :bigyello:
Try ()?
I've seen some weird bugs around () before.Code:Public Property Get CheckedPathCount() As Long
CheckedPathCount = GetCheckedPathCount()
End Property
Strictly speaking it would be; you'd just cache the check status on your end to combine from multiple folders and restore it if needed. But yes ucShellTree is better for this. You could in theory remove the checkboxes from folders by setting the state image index to 0... it would require some doing, I'll look into it as a feature for next version. I'll be doing big work on these controls again soon now that twinBASIC's new version is out (ucShellTree is currently not working on it so not for another few days).Quote:
That's not possible, because the user must have the possibility to select files from different directories/drives. Thats the reason i switched from CommonDialogs to this ShellTree!
Was there an issue with how I was going to set it up? I haven't tested it yet, no time right now.Quote:
How about to add this before the event-raise for check/uncheck?
Feature request: "ShowHiddenFileExtensions":
Your control supports ShowHiddenItems & ShowSuperHidden but i miss a property to enable the forced display of file extensions to override the system settings of the windows explorer.
Is that possible?
VB6SP6 Win10x64
I compiled your control as an OCX and use binary compatibility to avoid multiple ClassIDs for each new compiled OCX.
Now VB6 crashes everytime when i start my test project in the IDE and a form with the control is displayed.
This also happens when i run the test project as an compiled EXE.
I get no crash if i open the form with the control in the IDE and edit some properties.
Info: No crash happens if i compile the OCX without any compatibility but this no pratical solution.
How to use the ShellTree as an OCX with binary compatibility?
Certainly possible; ucShellBrowse has such an option. Just takes a bit of work to set up correctly; you can't just switch the name queried for everything because then you wind up showing extensions that should be hidden even when extensions are shown (e.g. .lnk on shortcuts) and GUIDs for some virtual items.
I really don't know too much about this since I never use them as ocx myself beyond test compiles; I think it's a general issue rather than ucShellTree-specific so a thread about it might get some answers; you may need to unregister and delete the previous versions if you want to compile with binary compatibility, because I think that problem arises when you compile it and it's *not* actually compatible.Quote:
How to use the ShellTree as an OCX with binary compatibility?
I posted a question to the VB6 group: OCX crashes when compiled with binary compatibility
But i guess it have something to do with your code because i use a lof of OCXs with binary compatibility and never had any issue until today.
I guess i will add debug code to the OCX to check where exactly the OCX crashes. Stay tuned for the result...
The compiled OCX with binary compatibility crashes in the function CreateTreeView at the line CreateTreeView = CreateWindowEx(...)
Debug values before CreateWindowEx:Code:Private Function CreateTreeView(hwndParent As Long, _
iid As Long, _
dwStyle As Long, _
dwExStyle As Long) As Long
DebugToFile "CreateTreeView_Start"
Dim rc As oleexp.RECT ' parent client rect
Call GetClientRect(hwndParent, rc)
DebugToFile "CreateTreeView_1"
' Create the TreeView control.
CreateTreeView = CreateWindowEx(dwExStyle, WC_TREEVIEW, "", _
dwStyle, 0, 0, rc.Right, rc.Bottom, _
hwndParent, iid, App.hInstance, 0)
DebugToFile "CreateTreeView_End"
End Function
Do you have any idea whats going on?Code:dwStyle: 1350638121
rc.Right: 297
rc.Bottom: 340
hwndParent: 3348196
iid: 100
App.hInstance: 285212672
I found another bug:
The folder "C:\test1" is root but showed again inside himself as a sub folder:
ShellTree:
Attachment 190204
Windows Explorer:
Attachment 190205
Code to reproduce:
Solution:Code:ucTree.CustomRoot = "C:\test1"
ucTree.OpenToPath "C:\test1", True
Avoid using OpenToPath with a path that is used as CustomRoot or add this to the OpenToPath function:
Code:if OpenToPath = CustomRoot then Cancel OpenToPath
Yeah I didn't put in too many checks against the user shooting themselves in the foot :D But I'll add that check.
Check/Uncheck item visually select issue
A item isnt selected when checking or unchecking the item.
Here i checked the item "DVD" but the item "Boot" is still selected:
Attachment 190214
IMHO it should be like this:
Attachment 190215
How can i select the item in the ItemCheck event using the variable hItem?
TreeView_SetItemState hTVD, hItem, TVIS_SELECTED, TVIS_SELECT
But I definitely wouldn't want that behavior so if I add it, it would be a default-off option. Note it's probably going to trigger all the code that fires when you click the item; if it does, to avoid it you'd have to set a module-level flag like 'bIgnoreThisSelection' and set it before then clear it after, then wrap all the selected item code in it.
I tried it with SendMessage inside the ItemClick event but it doesnt work:
Debug values:Code:
Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub ucTree_ItemCheck(sName As String, sFullPath As String, bFolder As Boolean, fCheck As Long, hItem As Long)
Const TV_FIRST = &H1100
Const TVM_SELECTITEM = (TV_FIRST + 11)
Const TVGN_CARET = &H9
Debug.Print "hWndTreeView:"; ucTree.hWndTreeView
Debug.Print "hItem:"; hItem
Debug.Print SendMessageAny(ucTree.hWndTreeView, TVM_SELECTITEM, TVGN_CARET, hItem)
End Sub
Strange, you use the same SendMessage call in the CTL to select an item but in the ItemClick event it doesnt work.Code:hWndTreeView: 4659090
hItem: 230647432
0
Any ideas?
The SHBrowseForFolder dialog supports the creation of new folders in the tree.
Is this somehow possible with ucShellTree too?
e.g. add a new TreeViewItem and start the Label edit mode to set the name of the new folder.
Thought I added that already... guess not... ucShellBrowse can... Will do. Going to need a few days though my Windows install went insane I'm going to be down a couple days for a reinstall, can't do any serious programming on my tablet.
I have tB on my tablet its just a pain to use and im focused on fixing things. I'm done backing up files and making install media so hopefully by tonight; vb6 and tB get reinstalled first.
How can i display the .ZIP extension in the tree?
Attachment 190271
For the user it is confusing without the file extension.
The first and second zip file looks like a folder and the 3. zip file looks like a txt file...
my ucShellTree properties:
i guess something like this should be added:Code:ShowFiles = True
mNeverExpandZip = True
ExpandZip = False
Code:if ShowFiles = True AND mNeverExpandZip = True AND ExpandZip = False then ShowZipExtension=True
Hiding extensions is one of the worst default settings of Windows ever yet they've refused to correct that for decades despite being bad for usability and worse for security.
The option to always show extensions or use explorer will be in the next version. If you want to test if it's working right for me and/or backport from tB to VB6, https://github.com/fafalone/ShellCon...ellTree2-9-2-a
If you're still refusing to join us in the future, you can view ucShellTree.twin as text in the browser, it's the source code file for the control.
The changes are much more substantial than the others; a lot more sections had to be changed and rearranged for this, too many to put into this post.
Code:'v2.9.2 (ALPHA, 29 Jan 2024)
'-New FileExtensions property to choose between following Explorer's setting for hiding
' known extensions, over forcing them to always show.
'
'-Added property CheckedPathCount.
'
'-Added UserOption mNeverExpandZip, to prevent expansion of .zip when ShowFiles = True.
'
'-(Bug fix) Border property not restored correctly due to re-reading it with the wrong
' name from the property bag.
'
'-(Bug fix) Opening to a custom root would add the root as a child of itself.
I transfered all your changes from the Twinbasic control to the VB6 control but now i see that your changes make it impossible to use them in the VB6 CTL file.
You added Krool's subclassing and this requires the use of an external module for the subclassing functions. The use of the AddressOf operator doesnt work if the sublass functions are not in a module...
I use not only ucShellTree as a ctl exclusively, but also Krool's VBCCR and VBFlexGrid controls, exclusively, as ctl. I assure you it's not impossible, it just requires having a standard module as a helper.
But the method of subclassing isn't of particular importance. You could leave the old IPAO/subclassing routines and just port the substantive code changes.
ucShellTree and ucShellBrowse was the very first project I ported... was just excited to try out tB and didn't think to keep the code completely compatible. I was thinking more along the lines of 'look for the FileExtensions property, it's associated variable and property, and add those in' rather than backport the entire project... that's going to be much more work. There's changes to be made to switch between WinDevLib and oleexp.tlb too. And IIRC I used tB syntax in other places. Later projects I tried to keep the code of existing projects compatible, but I've never gotten around to wholesale backporting the new ucShellTree/ucShellBrowse versions.
Even if the "WndProc" needs to reside in a module as to accommodate the "AddressOf" operator, all it does is forward messages to any of your classes that implement the "ISubclass" interface:
ISubclass.clsCode:Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal Subclass As ISubclass, ByVal dwRefData As Long) As Long
Select Case uMsg
Case WM_NCDESTROY
UnSubclassWnd hWnd: WndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
Case Else
WndProc = Subclass.WndProc(hWnd, uMsg, wParam, lParam, dwRefData)
End Select
End Function
I haven't looked at Krool's controls but isn't he using the same subclassing method? It's pretty "boiler plate"...Code:Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal dwRefData As Long) As Long
End Function
I transfered all your changes from the Twinbasic control (v2.9.2) to the VB6 control excluding the Subclassing.
The control is running but now something is strange:
ucTree.OpenToPath "C:", True
Attachment 190277
drive C should be displayed under Computer and not as a child of the Desktop.
Expanding some items:
Attachment 190278
control properties:
How to fix that?Code:ShowFavorites = False
Checkboxes = True
ShowFiles = False
AutoExpandComputer = False
AutoExpandLibraries = False
ShowQuickAccessOnWin10 = false
VB6SP6, Win10x64, uShell 2.9.2
I miss the overlay icons for LNK files, junctions and symbolic links in the tree.
Windows Explorer:
Attachment 190288
ucShellTree:
Attachment 190289
I set .ExtendedOverlays = True to get this overlay icons but the app/ide crashes when displayed.
Does ExtendedOverlays show the missing overlay icons or is this a new feature to add?
Code:'v2.17 (Released 15 Mar 2020)
'
'-(Bug fix) The default overlays that should always stay on weren't showing (Link/Share)
Extended overlays is for overlays besides links/junctions and shares; if you turn off extended overlays, the simple ones should still show:
But it looks like a bug. Not sure how it happened because I specifically made sure it was working before I released the icon size update a few weeks ago.Code:lpIconOvr = -1
If mExtOverlay Then
Set pIconOvr = psf
pIconOvr.GetOverlayIndex pidlRel, lpIconOvr
End If
If (lpIconOvr > 15) Or (lpIconOvr < 0) Then
'Overlay icons are a mess. On Win7 there's a bunch in root that return 16, which is invalid
'and will cause a crash later one, and doesn't show anything. Shares never get shown so I'm
'going to manually set those
lpIconOvr = -1
If (lAtr And SFGAO_SHARE) = SFGAO_SHARE Then
lpIconOvr = 1
End If
If (lAtr And SFGAO_LINK) = SFGAO_LINK Then
lpIconOvr = 2
End If
End If
I think Windows uses one or two more in some cases but it's mostly for apps that install custom ones; not too many do because there's a global system limit of 15. I'll investigate the crashing and why it's failing to show the overlays despite no errors setting them; the code is taken from ucShellBrowse where they're still working.
With ucShell v2.7 the overlay icons are visible but the icon for a junction is wrong:
Attachment 190290
A junction uses a different icon than a symbolic link or a shortcut:
Attachment 190291
I guess the problem with the missing overlay icons is triggered by the new function EnsureOverlay:
Code:lpIconOvr = -1
If mExtOverlay Then
Set pIconOvr = psf
pIconOvr.GetOverlayIndex pidlRel, VarPtr(lpIconOvr)
End If
If (lpIconOvr > 15) Or (lpIconOvr < 0) Then
'Overlay icons are a mess. On Win7 there's a bunch in root that return 16, which is invalid
'and will cause a crash later one, and doesn't show anything. Shares never get shown so I'm
'going to manually set those
lpIconOvr = -1
If (lAtr And SFGAO_SHARE) = SFGAO_SHARE Then
lpIconOvr = 1
End If
If (lAtr And SFGAO_LINK) = SFGAO_LINK Then
lpIconOvr = 2
End If
End If
EnsureOverlay lpIconOvr