ucShellTree.twin

[FormDesignerId("152922CC-D332-4D27-BEF0-7D0887461FEF")]
[ClassId("85A86C8E-6760-4A3A-9829-9757C29E1A60")]
[InterfaceId("C0C3AAC5-88FC-49E2-B061-151FDB8E0BAC")]
[EventInterfaceId("1D32F2E5-68B8-4168-B712-C80C57BC83BB")]
[COMControl]
[Description("ShellControls ucShellTree")]
Public Class ucShellTree
Option Explicit

Private Const mVersionStr As String = "Shell Tree Control 2.9.2"

#Region "README"
''*********************************************************************************************
'ShellControls TB
'{88049843-B8DE-4955-BD3B-E6A5790F5217}
'
'ucShellTree.twin
'Shell Tree Control v2.9.2 - twinBASIC Implementation
'
'Author: fafalone
'(c) 2018-2025
'
'For questions, comments, and bug reports, stop by the project thread:
'http://www.vbforums.com/showthread.php?862137-ucShellTree-Full-featured-Shell-Tree-UserControl
'
'
'This twinBASIC version doesn't use tlb since upgrading oleexp to x64 compatibility wasn't 
'happening... all oleexp imports are handled by an x64 compatible successor to
'oleexp: WinDevLib.
'
'
'----------------------------------------ABOUT-------------------------------------------
'This UserControl displays a TreeView of the Windows Shell, similar to the one
'found in Explorer. While there are other controls that are similar, and there's
'also the INamespaceTreeControl that actually hosts an Explorer TreeView, this has
'the advantage that it has modern styling and features that weren't available before
'Windows Vista, but being completely done in VB provides customizations that are
'not possible with the hosted object.
'
'-------------------------------------REQUIREMENTS---------------------------------------
'-Windows Vista or newer
'-oleexp.tlb v4.42 or higher
'
'STRONGLY RECOMMENDED: Common Controls 6.0 manifest. Partial and exclusion checkboxes will
'                      not work, visual styling is effected, and other features may not work
'                      as well.
'-------------------------------------KEY FEATURES---------------------------------------
'-Displays complete Explorer-type tree with either Desktop or Computer as the root folder.
'-Tri-state checkboxes show partial selections when check mode is enabled
'-Supports drag/drop with modern drag images and drag-over-highlighting (including
'  expanding on hover), based on my cDropTarget project. Can drop on all valid drop targets:
'  folders, zip files, programs, shortcuts to them, etc.
'-Right-click shows the standard Explorer context menu for the clicked item
'-Automatically monitors for changes (item created, deleted, renamed) and updates the
'  tree accordingly.
'-Option to show files as well
'-Can automatically expand to a given path. NOTE: OpenToPath/OpenToItem can only be used
'  after loading; to open to a path on your Form_Load or Main() routine, use .InitialPath
'-InfoTips with several lines of details depending on file type are shown as ToolTips
'-Filter option can limit the type of files displayed (or even folders)
'-Can rename in place using LabelEdit
'-Can (optionally) treat .zip/.cab files as a folder
'-Optional additional root entry for 'Favorites' that shows the Links folder.
'-Browses the Network folder too and returns paths as \\Share\etcetc
'-Complete Unicode support
'
'
'---------------------------------------CHANGELOG----------------------------------------
'v2.9.3 
'-Updates to work with twinBASIC 896+
'
'-(Bug fix) Major GDI handle leaks during redraw
'
'v2.9.2 
'
'Special thanks to VBForums user Mith for his incredible work helping with new features
'and bug fixes! Credit goes to him for most of the changes in 2.9.2 alpha and final.
'
'-Added ShowOnlyFileCheckboxes option: When Checkboxes = True and ShowFiles = True, will 
' show checkboxes only for files.
'
'-Try to load cached icons first
'
'-Minor sizing adjustment to eliminate 4px border.
'
'-(Bug fix) Default share/shortcut overlays not showing.
'
'-(Bug fix) New icon methods didn't properly support running without ComCtl6.
'
'-(Bug fix) Always Show extensions wasn't working.
'
'-(Bug fix) Disabling of Wow64 redirection wasn't reverted on terminate.
'
'-(Bug fix) If DPI awareness was on, IconSize would continuously grow.
'
'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.
'
'v2.9.1 (Released Jan 27th, 2024)
'-(Bug fix) AutoCheck = False not respected when expanding a checked folder (thanks to
'           VBForums user Mith for report and fix)
'
'-(Bug fix) When AutoCheck = False and CheckBoxes = True is set at runtime, checkboxes
'           improperly cycled through partial checks. This is currently fixed as a work-
'           around that will not work properly if ExclusionChecks = True (and AutoCheck
'           = False), but it may be some time before I Can run down a proper fix.
'
'
'v2.9 (Release Jan 15th, 2024)
'-Now using a mirrored image list to support arbitrary icon size.
'
'v2.8 R2
'-Updated tbShellLib to 2.6.62 with fixed hex literals, and fixed a couple ones in this
' control.
'
'v2.8
'
'(R1) IPAO hooking code integrated so as to not conflict with ucShellBrowse.
'
'-Added Indentation property to get/set the indent width of TreeView items.
'
'-Added functions InsertItemByPath and InsertItemByPidl, to insert other locations into
' places on the tree. If you leave the parent blank, the items will be added under the
' root. Note that the parent must already be visible (you can call OpenToPath/Item).
'
'-Quick Access replaced Favorites in the Windows 10 Explorer tree; this project can now
' optionally do the same with the ShowQuickAccessOnWin10 option. ShowFavorites must be
' enabled as well, then this option True (the default) to replace it.
'
'-Automatically expanding Computer/ThisPC is now an option, AutoExpandComputer, and also
' there's an option to automatically expand Libraries as well, AutoExpandLibaries. Both
' are true by default, and are only applied if ComputerAsRoot is false and no custom
' root is being used.
'
'-Added selected node operations: SelectedNode[s]Expand, SelectedNode[s]Collapse, and
' SelectedNode[s]Toggle (toggle collapsed or expanded).
'
'-RefreshTreeView now preserves which item is selected.
'
'-Can now disable Wow64 redirection. Note: This is per-thread, so it should only be
' done once; if using with ucShellBrowse only one should have the option enabled, and
' it applies to both (and everything else in the thread).
'
'-If Multiselect was enabled, the MultiselectChange event and ItemClick event fired, but
' the ItemSelect event did not. It now does.
'
'-(Bug fix) Various issues with .CheckedPaths not matching what's seen on the tree have
'           been fixed by syncing the check data before reporting it. .ExcludedPaths does
'           this too now.
'
'-(Bug fix) SelectedItems did not fill in the string array of paths. 
'
'-(Bug fix) Renamed items did not have their name updated in the TreeView (though the rename
'           itself succeeded)
'
'v2.7 (Released 25 Jan 2022)
'
'-Added ShowHiddenItems/ShowSuperHidden options
'
'-Added EnableShellMenu option to control whether the right-click menu pops up.
'
'-Added SetFocusOnTree method.
'
'-Added public event for UserControl_EnterFocus and UserControl_ExitFocus (EnterFocus
' and ExitFocus, respectively).
'
'-(Bug fix) Keyboard focus never went to ucTreeView when on a form with ucShellBrowse.
'
'v2.6 (Released 03 Apr 2021)
'
'-Eliminated the need to use a variable to keep tracking of dir change operations when
' combining this control with a ucShellBrowse control; previously you'd handle a path
' change notification from the browser with
' If bChanging = False Then
'    bChanging = True
'    ucShellTree1.OpenToItem siItem, False
'    bChanging = False
' End If
' Now you no long need the bChanging variable.
'
'-Added SelectNone sub, which will clear all selected items (supports multiselect).
'
'-Added ItemSelectByShellItem event. I wanted to just include an IShellItem member in
' ItemSelect, but the backwards compatibility concerns are too great. This event will
' also include all the information of ItemSelect if you want to fully switch over.
'-Did the same for ItemClick->ItemClickByShellItem
'
'-For MultiSelect, added the MultiSelectChange event, which includes an IShellItemArray
' of selected items as well as a name list and full path list
'
'-(Bug fix) Using On Error Resume Next to handle an uninitialized array in the Terminate
'           event caused the control to freeze on compile or on run after changes if
'           you were using it as an OCX.
'
'
'v2.5 R2 (Released 15 Dec 2020)
'
'-(Bug fix) Navigation in unmapped Network locations wouldn't expand properly. This may
'           also have effected other items, as the bug involves scenarios where two
'           IShellItem.GetDisplayName calls for the same location return a different case
'           at a different time, which resulted in an infinite loop looking for something
'           that should have been there, because case differed unexpectedly.
'
'v2.5 (Released 09 Dec 2020)
'
'-Added BackColor and ForeColor (text) options.
'
'-Added some missing style options: AutoHScroll, NoIndentState, TrackSelect, and
' ShowSelAlways. The latter two are enabled by default.
'
'-Added RefreshTreeView function. There already is 'ResetTreeView', but that restores the
' tree to its state on load. RefreshTreeView resets it then expands all the folders that
' were previously expanded, which will make any updates in the folders that were visible
' as they're loaded from scratch.
'
'-To perform the refresh, a list is generated of not all folders, but just one per end
' node, otherwise there'd be potentially hundreds of useless OpenToPath calls.
' This list is available if you want to view or save it through the new GetExpansionState
' function. If you want to load a saved list, also added LoadExpansionState. You can pass
' any list of full paths in a string delimited by a | if desired.
'
'-(Bug fix) If a portable device (e.g. phone, camera) was connected while the control was
'           running, it wouldn't be added to the tree.
'
'v2.4 (Released 20 Sep 2020)
'
'-Extended Verbs for the Shell Context Menu is now an option. If it's set to False (the
' default), you will need to hold down Shift when bringing up the menu to show the
' additional items, the same way it works in Explorer.
'
'-(Bug fix) Eliminated all non-explicit types that were defined in the type library, so
'           that no further conflicts with Public versions are possible.
'
'v2.3 (Released 19 August 2020)
'
'-(Bug fix) Extended styles were being cleared improperly. Checkboxes, ExclusionChecks,
'           FadingExpandos, and MultiSelect would not turn off once enabled.
'
'v2.2 (Released 23 April 2020)
'
'-Added DropFiles event and DragStart event.
'
'-Added Multiselect option. MSDN says "Not supported, do not use." but this style appears
' to be working without issue. Be advised, this deprecated status means that it could cease
' to work in future versions of Windows without notice.
' This effects dragging items, and a new Public Sub SelectedItems has been added; these are
' the only places multiselect currently effects.
'
'-Added DisableDragDrop option if you want to disable it.
'
'
'v2.17 (Released 15 Mar 2020)
'
'-(Bug fix) The default overlays that should always stay on weren't showing (Link/Share)
'
'v2.16 (Released 05 Mar 2020)
'
'-Made extended overlays, found in programs such as TortoiseSVN and Dropbox, a default-off
' option due to the extreme performance cost (a factor of 10-100).
'
'v2.15 (Released 19 Feb 2020)
'
'-(Bug fix) If a Private Enum defined in a UserControl had the same name as one that
'           is defined in a module containing Sub Main, placing more than one of the
'           UserControl in a project caused the control to be grayed out and then an
'           app crash when any other control was initially added to the form.
'           To fix this, all API enums in this control have been prefixed with ucsb_
'           If you're modifying the code of this control, just keep that in mind.
'           No change is needed for using this control or any other code as they're
'           all Private.
'
'-(Bug fix) In ensuring a USB device is already added after OpenToItem, the GetNodeByPath
'           function did not handle USB paths properly, so additional USB device entries
'           were added to the tree.
'
'v2.14
'
'-(Bug fix) If a USB media device (phone, camera, etc-- no drive letter) was added after
'           the program started, it could not be added to the TreeView-- there was some
'           issue with an infinite loop where it kept finding the parent but not adding
'           the child. I couldn't figure out where it was going wrong, so implemented a
'           workaround where the control checks whether it's being asked to navigate to
'           one of these devices, and if it is, manually ensures the device is added.
'           After that, subfolder adding works fine, you can directly navigate to a deep
'           path and all the subfolders will be added; the issue was just adding the
'           device itself.
'
'-(Bug fix) The control uses the SHChangeNotifyRegister API without its own declare; there
'           is a declare in the typelib, and since it wasn't declared explicitly, any
'           Public version in a project module would take precedence, which sometimes
'           caused Type Mismatch errors if the declare was slightly different.
'
'v2.13
'
'-InfoTips are now cached on first load.
'
'-Now store fully qualified pidls for each item, which enables compatibility with the search
' folders generated by ucShellBrowse's new search method (ISearchFolderItemFactory), as these
' for some reason lack a relative pidl even though other direct children of the desktop do not.
' There may be other types of objects lacking a relative pidl as well; this can only increase
' the number of item types supported.
'
'-(Bug fix) In Design Mode, the control displayed "Shell Tree Control 1.0" instead of the current
'           version number. It now gets the info from mVersionStr on Line #2 of this module.
'
'v2.12 (Released 16 June 2019)
'-(Bug fix) On Windows 10, when browsing some virtual devices, like connected phones or cameras,
'           the SHCreateItemFromParsingName fails when 2 levels or deeper. Changed navigation,
'           selection generation, and other features to have full pidl records to fall back on.
'
'v2.11 (Released 15 Feb 2019 - Critical bug fix only)
'-(Bug fix) Previous fix regarding PathMatchSpecW resulted in always loading the Computer
'           folder as root.
'
'v2.1 (Released 30 Jan 2019)
'-The font for the TreeView is now a standard property. (Borrowed from Krool's
' TreeView. Thanks!)
'
'-Shell context menu tips are now passed in the StatusMessage event.
'
'-Filter now supports multiple patterns separated by semi-colon.
'
'-Replaced Border property with BorderStyle, which has several more options.
'
'-(Bug fix) If the control was on a secondary form, unloading that form did not unload
'           the control, and it stayed loaded in the background until the whole program
'           ended. Thanks to dz32 and Eduardo- for figuring out the solution.
'
'-(Bug fix) Fixed automatic navigation not expanding when a parent of a parent was
'           collapsed; only the immediate parent was checked previously.
'
'-(Bug fix) Custom Roots were checked for validity with PathMatchSpecW, which does
'           not support virtual locations. Now it's checked by going ahead and trying
'           to create the IShellItem for it, allowing roots like ::{GUID}
'v2
'
'-You can now specify a custom folder as root*. Changeable during runtime.

'-Added PathGetCheck and PathSetCheck functions. The Set function also has an option to
' expand to show the given path in the event it's not yet visible.
'
'-The OpenToPath/OpenToItem functions now have an option to just expand to but not select
' the item, primarily for the check set function but available in general; default=select.
'
'-The .InitialPath property is deprecated. The creation sequence has changed, you can
' now just use OpenPath in your Form_Load (or equiv.) event. It remains for compatibility.
'
'-Added RootHasCheckbox option to set whether or not one appears (when checkboxes are enabled).
'
'-Added ExclusionChecks option, which adds an additional checkbox state- a red x. The .ExcludedPaths
' method functions in the same way as the .CheckedPaths method to retrieve paths in this state (they
' are not counted as checked).
'
'-Added ExplorerStyle option to allow control over whether the Explorer visual style is applied.
'
'-Added HorizontalScroll option, to set whether the tree expands without needed HScroll.
'
'-Adjusted the RootHasCheckbox option so that if it's changed at runtime, the correct state is set.
'
'-Changed disable criteria such that valid file drop targets are excepted from normal disabled prop
' list. This was mainly to get the Recycle Bin enabled since it's completely browsable. Other items
' remain disabled. (You can change this in TVExpandFolder if desired).
'
'-Added Autocheck option for control over whether partial checks are shown and whether parent and
' child items are automatically changed according to a new check action.
'
'-The control will now fall back to plain checkboxes if no Common Control 6 manifest is present, but
' all autocheck functionality is unavailable (even checking all children of a checked parent).
' Previously checkboxes were not present at all without a manifest.
'
'(Bug fix) The outer edge of the control on dragover indicated a droptarget on no item but
'          seemingly valid; it now correctly shows no drop is possible.
'
'(Bug fix) Invalid (malformed/corrupt) shortcut files caused an error that wasn't handled, so
'          the item enumeration when expanding a folder stopped when it reached it.
'
'(Bug fix) When you call GetParent on your user folder, you get the desktop instead of \Users\,
'          this caused some issues with auto-navigating.
'
'(Control/code) So I thought you needed to supply your own check imagelist for partial checkboxes,
'               since the extended style wasn't working, but it turned out the problem was just that
'               you can't set the TVS_CHECKBOXES style; just TVS_EX_PARTIALCHECKBOXES. So the images
'               have been removed, which eliminates transparency issues and will keep the appearance
'               the same as the OS.
'
'-------
'* - Technical note: This can be any path string/identifier resolvable by SHCreateItemFromParsingName
'
'*********************************************************************************************
#End Region

'USER OPTIONS
'The following are meant to be toggled based on your preferences:
Private Const dbg_PrintToImmediate As Boolean = False 'This control has very extensive debug information, you may not want
                                                     'to see that in your IDE.
Private Const dbg_IncludeDate As Boolean = True 'Prefix all Debug output with the date and time, [yyyy-mm-dd Hh:Mm:Ss]
Private Const dbg_RaiseEvent As Boolean = True 'Raise DebugMessage event
Private Const dbg_MinLevel As Long = 0& 'Only fire debug statement if iLvl >= this value

Private Const mNeverExpandZip As Boolean = False 'Never expand a zip under any circumstances.
'-----------------------------------------------------------------------------------------------

#Region "ProjectDeclares"
Implements IDropTarget
Implements IOleInPlaceActiveObjectVB
Implements IObjectSafety

Public Event StatusMessage(sMsg As String)
Public Event ItemClick(sName As String, sFullPath As String, bFolder As Boolean, nButton As Long, hItem As LongPtr)
Public Event ItemClickByShellItem(siItem As IShellItem, sName As String, sFullPath As String, bFolder As Boolean, nButton As Long, hItem As LongPtr)
Public Event ItemSelect(sName As String, sFullPath As String, bFolder As Boolean, hItem As LongPtr)
Public Event ItemSelectByShellItem(siItem As IShellItem, sName As String, sFullPath As String, bFolder As Boolean, hItem As LongPtr)
Public Event MultiSelectChange(siaItems As IShellItemArray, sNames() As String, sFullPaths() As String)
Public Event ItemCheck(sName As String, sFullPath As String, bFolder As Boolean, fCheck As Long, hItem As LongPtr)
Public Event ItemExpand(sName As String, sFullPath As String, hItem As LongPtr)
Public Event ItemCollapse(sName As String, sFullPath As String, hItem As LongPtr)
Public Event TreeKeyDown(VKey As Integer)
Public Event ItemRename(sNameOld As String, sNameNew As String, sFullPathOld As String, sFullPathNew As String, bFolder As Boolean, hItem As LongPtr)
Public Event Initialized()
Public Event DropFiles(sFiles() As String, siaFiles As IShellItemArray, doDropped As IDataObject, sDropParent As String, siDropParent As IShellItem, dwDropEffect As DROPEFFECTS, dwKeyState As Long, ptPointX As Long, ptPointY As Long)
Public Event DragStart(sFiles() As String, siaDragged As IShellItemArray, pdoDragged As IDataObject)

Public Event EnterFocus()
Public Event ExitFocus()

Public Event DebugMessage(sMsg As String, iLevel As Integer)

Private m_ScaleX As Single, m_ScaleY As Single
Private bLoadDone As Boolean
Private pDTH As IDropTargetHelper
Private Const CLSID_DragDropHelper = "{4657278A-411B-11D2-839A-00C04FD918D0}"
Private m_hWnd As LongPtr
Private bRegDD As Boolean
Private psfCur As IShellFolder
Private siaSelected As IShellItemArray
Private sSelectedItems() As String
Private siaSIH As IShellItemArray
Private lUDTC As Long, sUDsz As String
Private mTmrProc As LongPtr
Private idTmr As LongPtr
Private mRefreshPaths() As String

Private bIsWinVistaOrGreater As Boolean 'This control will not run on XP or lower
Private bIsWin7OrGreater As Boolean
Private bIsWin8OrGreater As Boolean
Private bIsWin10OrGreater As Boolean

Private bIsWow64 As Boolean
Private lWow64Data As Long

Private hFontTV As LongPtr
Private WithEvents PropFont As StdFont
Private mIFMain As IFont

Private lLoopTrack As Long

Private mBkm As Boolean

Private m_hRoot As LongPtr
Private m_hFav As LongPtr

Private mCustomRoot As String
Private Const mCustomRoot_def As String = ""
Private bCustRt As Boolean

Private bQkAc As Boolean

Private sUserFolder As String
Private sUserDesktop As String

Private himlTV As LongPtr
Private himl16 As LongPtr
Private himl32 As LongPtr
Private himl48 As LongPtr
Private himl64 As LongPtr
Private himl96 As LongPtr
Private himl128 As LongPtr
Private himl256 As LongPtr
Private imlSysJM As IImageList
Private imlSysSM As IImageList

Private mIconSize As Long
Private Const mDefIconSize As Long = 24

Private gdipToken As LongPtr

Private Type SysImgCacheEntry
    sysimlid As Long
    limlidx As Long
End Type
Private SysImgCache() As SysImgCacheEntry
Private nSysImgCache As Long
Private bOvrAdded(16) As Boolean


Private Type TVEntry
    bFolder As Boolean
    bZip As Boolean
    bLink As Boolean
    bFavorite As Boolean
    sFullPath As String
    sName As String
    sNameFull As String
    sParentFull As String
    sLinkTarget As String
    sInfoTip As String
    LinkPIDL As LongPtr
    bLinkIsFolder As Boolean
    bDropTarget As Boolean
    hNode As LongPtr
    hParentNode As LongPtr
    nIcon As Long
    nOverlay As Long
    dwAttrib As SFGAOF
    Checked As Boolean
    Excluded As Boolean
    bDisabled As Boolean
    bDeleted As Boolean
    pidlFQPar As LongPtr
    pidlRel As LongPtr
    pidlFQ As LongPtr
    bIsDefItem As Boolean
End Type
Private TVEntries() As TVEntry
Private nCur As Long
Private TVVisMap() As TVEntry
Private nTVVis As Long
Private bFlagRecurseOI As Boolean

Private fRefreshing As Long

Private hTVD As LongPtr
Private ICtxMenu2 As IContextMenu2
Private ICtxMenu3 As IContextMenu3
Private Const wIDSel As Long = 3000&
Private bSetParents As Boolean
Private bFilling As Boolean
Private gPaths() As String
Private nPaths As Long
Private gExPaths() As String
Private nExPaths As Long
Private nItr As LongPtr
Private hSysIL As LongPtr
Private pIML As IImageList
Private g_fDeleting As Boolean
Private fNoExpand As Long
Private sFavPath As String
Private siSelected As IShellItem
Private sSelectedItem As String
Private gCurSelIdx As LongPtr
Private m_hSHNotify As Long
Private Const WM_SHNOTIFY = &H477
Private hLEEdit As LongPtr
Private sOldLEText As String
Private bRNf As Boolean
Private Const sQuickAccess = "shell:::{679f85cb-0220-4080-b29b-5540cc05aab6}"
Private Const sComp = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
Private Const sLibRoot = "::{031E4825-7B94-4dc3-B131-E946B44C8DD5}\"
Private Const lnLibRoot As Long = 41& 'length
Private ddRightButton As Boolean
Private bNoDrop As Boolean
Private lHover1 As Long, lHover2 As Long
Private bFlagBlockClkExp As Boolean
Private hItemBlocked As LongPtr
Private bBlockExec As Boolean
Private bNavigating As Boolean
Private fLoad As Long
Private sDesktopPath As String
Private m_cbSort As LongPtr
Private m_sAltDrop As String
Private szNavWav As String
Private xHover As Long, yHover As Long
Private bHoverFired As Boolean
Private sFolder As String
Private bAbort As Boolean
Private bNoTarget As Boolean
Private lItemIndex As LongPtr
Private mDragOver As String
Private mDropTipMsg As String
Private mDropTipIns As String
Private mDropTipImg As DROPIMAGETYPE
Private mDefEffect As DROPEFFECTS
Private mAllowedEffects As DROPEFFECTS
Private mDataObj As IDataObject
Private lvDragOverIdx As Long
Private IsComCtl6 As Boolean
Private lParamSort As LongPtr

Private clrBack As stdole.OLE_COLOR
Private clrFore As stdole.OLE_COLOR


Private mCheckboxes As Boolean
Private Const mCheckboxes_def As Boolean = False
Private mExCheckboxes As Boolean
Private Const mExCheckboxes_def As Boolean = False
Private mAutocheck As Boolean
Private Const mAutocheck_def As Boolean = True

Private mExplorerStyle As Boolean
Private Const mExplorerStyle_def As Boolean = True

Private mExpandZip As Boolean
Private Const mExpandZip_def As Boolean = False

Private mShowFiles As Boolean
Private Const mShowFiles_def As Boolean = False

Private mFadeExpandos As Boolean
Private Const mFadeExpandos_def As Boolean = True

Private mShowLines As Boolean
Private Const mShowLines_def As Boolean = False

Private mHasButtons As Boolean
Private Const mHasButtons_def As Boolean = True

Private mSingleExpand As Boolean
Private Const mSingleExpand_def As Boolean = False

Private mMultiSel As Boolean
Private Const mDefMultiSel As Boolean = False

Private mShowOnlyFileCheckbox As Boolean
Private Const mDefShowOnlyFileCheckbox As Boolean = False

Private mDisableDD As Boolean
Private Const mDefDisableDD As Boolean = False

Private mComputerAsRoot As Boolean
Private Const mComputerAsRoot_def As Boolean = False

Private mFullRowSelect As Boolean
Private Const mFullRowSelect_def As Boolean = True

Private mFilter As String
Private Const mFilter_def As String = "*.*"

Private mIndent As Long
Private Const mDefIndent As Long = 19

Private mFilterFilesOnly As Boolean
Private Const mFilterFilesOnly_def As Boolean = True

Private mInfoTipOnFiles As Boolean
Private Const mInfoTipOnFiles_def As Boolean = True

Private m_TrackSel As Boolean
Private Const m_def_TrackSel As Boolean = True

Private mShowSelAlw As Boolean
Private Const mDefShowSelAlw As Boolean = True

Private mExpandOnLabelClick As Boolean
Private Const mExpandOnLabelClick_def As Boolean = False

Private mNoIndState As Boolean
Private Const mDefNoIndState As Boolean = False

Private mAutoHS As Boolean
Private Const mDefAutoHS As Boolean = True

Private mInfoTipOnFolders As Boolean
Private Const mInfoTipOnFolders_def As Boolean = False

Private mNavSound As Boolean
Private Const mNavSound_def As Boolean = True

Private mFavorites As Boolean
Private Const mFavorites_def As Boolean = True

Private mSHCN As Boolean
Private Const mSHCN_def As Boolean = True

Private mLabelEdit As Boolean
Private Const mLabelEdit_def As Boolean = True

Private mNameColors As Boolean
Private Const mNameColors_def As Boolean = True
Private m_SysClrText As Long

Private mExtOverlay As Boolean
Private Const m_def_ExtOverlay As Boolean = False

Private mAlwaysShowExtVerbs As Boolean
Private Const mDefAlwaysShowExtVerbs As Boolean = False

Private m_EnableShellMenu As Boolean
Private Const m_def_EnableShellMenu As Boolean = True

Private m_Win10QA As Boolean
Private Const m_def_Win10QA As Boolean = True

Private mExpComp As Boolean
Private Const mDefExpComp As Boolean = True

Private mExpLib As Boolean
Private Const mDefExpLib As Boolean = True

Private m_NoWow64 As Boolean
Private Const m_def_NoWow64 As Boolean = False

#If TWINBASIC Then
[EnumId("869CCDEE-23AD-4F26-BC13-E75177292A05")]
#End If
Public Enum ST_HDN_PREF
    STHP_UseExplorer = 0&
    STHP_AlwaysShow = 1&
    STHP_AlwaysHide = 2&
End Enum
Private m_HiddenPref As ST_HDN_PREF
Private Const m_def_HiddenPref As Long = 0&
Private mHPInExp As Boolean

#If TWINBASIC Then
[EnumId("869CCDEE-23AD-4F26-BC13-E75177292A06")]
#End If
Public Enum ST_SPRHDN_PREF
    STSHP_UseExplorer = 0&
    STSHP_AlwaysShow = 1&
    STSHP_AlwaysHide = 2&
End Enum
Private m_SuperHiddenPref As ST_SPRHDN_PREF
Private Const m_def_SuperHiddenPref As Long = 0&
Private mSHPInExp As Boolean

#If TWINBASIC Then
[EnumId("869CCDEE-23AD-4F26-BC13-E75177292A07")]
#End If
Public Enum ST_EXT_PREF
    STEP_UseExplorer = 0&
    STEP_AlwaysShow = 1&
End Enum
Private m_ForceExt As ST_EXT_PREF
Private Const m_def_ForceExt As Long = 0&
Private mExSetExt As Boolean


'Private mBorder As Boolean
'Private Const mBorder_def As Boolean = True
#If TWINBASIC Then
[EnumId("869CCDEE-23AD-4F26-BC13-E75177292A08")]
#End If
Public Enum ST_BORDERSTYLE
    STBS_None = 0&
    STBS_Standard = 1&
    STBS_Thick = 2&
    STBS_Thicker = 3&
End Enum
Private mBorder As ST_BORDERSTYLE
Private Const mBorder_def As Long = 1&

Private mInitialPath As String
Private Const mInitialPath_def As String = ""

Private mRootHasCheckbox As Boolean
Private Const mRootHasCheckbox_def As Boolean = False

Private mHScroll As Boolean
Private Const mHScroll_def As Boolean = True

Private lRaiseHover As Long
Private Const m_def_lRaiseHover As Long = 2500&

Private bTopLostFocus As Boolean
Private bHasFocus As Boolean
Private hBmpBack As LongPtr
#End Region

#Region "APIDeclares"
'------------------------------------------------------------
'BEGIN STANDARD APIs AND SYSTEM CONSTANTS

'I'm going to try to have a bitmap background at some point, but it's not ready yet.
Private Type PAINTSTRUCT
        hDC As LongPtr
        fErase As Long
        rcPaint As RECT
        fRestore As Long
        fIncUpdate As Long
        rgbReserved(32) As Byte
End Type
Private Type BITMAP
    BMType As Long
    BMWidth As Long
    BMHeight As Long
    BMWidthBytes As Long
    BMPlanes As Integer
    BMBitsPixel As Integer
    BMBits As LongPtr
End Type
Private Declare PtrSafe Function BeginPaint Lib "user32" (ByVal hWnd As LongPtr, lpPaint As PAINTSTRUCT) As LongPtr
Private Declare PtrSafe Function EndPaint Lib "user32" (ByVal hWnd As LongPtr, lpPaint As PAINTSTRUCT) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtr
Private Declare PtrSafe Function StretchBlt Lib "gdi32.dll" (ByVal hDC As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal XSrc As Long, ByVal YSrc As Long, ByVal hSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, ByVal nBkMode As Long) As Long
Private Declare PtrSafe Function TransparentBlt Lib "msimg32" (ByVal hDestDC As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long
Private Const TRANSPARENT = 1&
Private Const OPAQUE = 2&

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pv As LongPtr)
Private Declare PtrSafe Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectW" (ByRef lpLogFont As LOGFONT) As LongPtr
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function DestroyIcon Lib "user32.dll" (ByVal hIcon As LongPtr) As Long
Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function DispatchMessage Lib "user32" Alias "DispatchMessageW" (ByRef lpMsg As Any) As LongPtr
Private Declare PtrSafe Function DllGetVersion Lib "comctl32" (ByRef pdvi As DLLVERSIONINFO) As Long
Private Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal fEnable As Long) As Long
Private Declare PtrSafe Function FindResourceW Lib "kernel32" (ByVal hInstance As LongPtr, ByVal lpName As LongPtr, ByVal lpType As LongPtr) As LongPtr
Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal VKey As Long) As Integer
Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As Any) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function GetMenuItemCount Lib "user32" (ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function GetMenuItemID Lib "user32" (ByVal hMenu As LongPtr, ByVal nPos As Long) As Long
Private Declare PtrSafe Function GetObjectW Lib "gdi32" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As SystemMetrics) As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Function ImageList_ReplaceIcon Lib "comctl32.dll" (ByVal himl As LongPtr, ByVal i As Long, ByVal hIcon As LongPtr) As Long
Private Declare PtrSafe Function InsertMenuItemW Lib "user32" (ByVal hMenu As LongPtr, ByVal uItem As Long, ByVal fByPosition As Boolean, lpmii As MENUITEMINFOW) As Boolean
Private Declare PtrSafe Function IsEqualGUID Lib "ole32" (iid1 As UUID, iid2 As UUID) As Long
Private Declare PtrSafe Function IsWow64Process Lib "kernel32.dll" (ByVal hProcess As LongPtr, ByRef Wow64Process As Long) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal uIDEvent As LongPtr) As Long
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorW" (ByVal hInstance As LongPtr, ByVal lpCursorName As Any) As LongPtr
Private Declare PtrSafe Function LoadLibraryW Lib "kernel32" (ByVal lpLibFileName As LongPtr) As LongPtr
Private Declare PtrSafe Function LoadResource Lib "kernel32" (ByVal hInstance As LongPtr, ByVal hResInfo As LongPtr) As LongPtr
Private Declare PtrSafe Function LockResource Lib "kernel32" (ByVal hResData As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As LongPtr
Private Declare PtrSafe Function lstrlenA Lib "kernel32" (lpString As Any) As Long
Private Declare PtrSafe Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare PtrSafe Function MessageBoxW Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal wType As Long) As Long
Private Declare PtrSafe Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare PtrSafe Function OleGetClipboard Lib "ole32" (ppDataObj As IDataObject) As Long
Private Declare PtrSafe Function OleTranslateColor Lib "oleaut32" (ByVal Color As Long, ByVal hpal As LongPtr, ByRef RGBResult As Long) As Long
Private Declare PtrSafe Function PathFileExistsW Lib "shlwapi" (ByVal lpszPath As LongPtr) As Long
Private Declare PtrSafe Function PathIsDirectoryW Lib "shlwapi" (ByVal lpszPath As LongPtr) As Long
Private Declare PtrSafe Function PathMatchSpecW Lib "shlwapi" (ByVal pszFileParam As LongPtr, ByVal pszSpec As LongPtr) As Long
Private Declare PtrSafe Function PathMatchSpecExW Lib "shlwapi" (ByVal pszFile As LongPtr, ByVal pszSpec As LongPtr, ByVal dwFlags As ucst_PMS_Flags) As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundW" (ByVal lpszName As LongPtr, ByVal hModule As LongPtr, ByVal dwFlags As ucst_SND_FLAGS) As Long
Private Declare PtrSafe Function PSFormatPropertyValue Lib "propsys.dll" (ByVal pps As LongPtr, ByVal ppd As LongPtr, ByVal pdff As PROPDESC_FORMAT_FLAGS, ppszDisplay As LongPtr) As Long
Private Declare PtrSafe Function RedrawWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal lprcUpdate As LongPtr, ByVal hrgnUpdate As LongPtr, ByVal fuRedraw As Long) As Long
Private Declare PtrSafe Function RegisterClipboardFormatW Lib "user32" (ByVal lpszFormat As LongPtr) As Long
Private Declare PtrSafe Function RegisterDragDrop Lib "ole32" (ByVal hWnd As LongPtr, ByVal DropTarget As IDropTarget) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function RevokeDragDrop Lib "ole32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hWnd As LongPtr, lpPoint As Any) As Long  ' lpPoint As POINT) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SendMessageW Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As LongPtr) As LongPtr
Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal cy As Long, ByVal wFlags As ucst_SWP_Flags) As Long
Private Declare PtrSafe Function SetWindowTheme Lib "uxtheme" (ByVal hWnd As LongPtr, ByVal pszSubAppName As LongPtr, ByVal pszSubIdList As LongPtr) As Long
Private Declare PtrSafe Function SHDoDragDrop Lib "Shell32" (ByVal hWnd As LongPtr, ByVal pdtobj As LongPtr, ByVal pdsrc As LongPtr, ByVal dwEffect As Long, pdwEffect As Long) As Long
Private Declare PtrSafe Function SHFileOperationW Lib "Shell32" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare PtrSafe Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As ucst_SHGFI_flags) As LongPtr
Private Declare PtrSafe Function SHGetFolderLocation Lib "shell32.dll" (ByVal hWndOwner As LongPtr, ByVal nFolder As Long, ByVal hToken As LongPtr, ByVal dwReserved As Long, ppidl As LongPtr) As Long
Private Declare PtrSafe Function SHGetImageList Lib "shell32.dll" (ByVal iImageList As ucst_ShellImageListFlags, ByRef riid As UUID, ByRef ppv As Any) As Long
Private Declare PtrSafe Function SHGetKnownFolderIDList Lib "Shell32" (rfid As Any, ByVal dwFlags As Long, ByVal hToken As LongPtr, pidl As LongPtr) As Long
Private Declare PtrSafe Sub SHGetSetSettings Lib "shell32.dll" (ByRef lpss As SHELLSTATE, ByVal dwMask As SFS_MASK, Optional ByVal bSet As Long)
Private Declare PtrSafe Function SHGetSettings Lib "Shell32" (lpsfs As Integer, ByVal dwMask As SFS_MASK) As Long
Private Declare PtrSafe Function StrCmpLogicalW Lib "shlwapi" (ByVal lpStr1 As LongPtr, ByVal lpStr2 As LongPtr) As Long
Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
Private Declare PtrSafe Function TrackPopupMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal wFlags As ucst_TPM_wFlags, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As LongPtr, lpRC As Any) As Long
Private Declare PtrSafe Function TranslateMessage Lib "user32" (ByRef lpMsg As Any) As Long
Private Declare PtrSafe Function UpdateWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32" (pOldVal As Long) As Long
Private Declare PtrSafe Function Wow64RevertWow64FsRedirection Lib "kernel32" (pOldVal As Long) As Long
#If Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Private Declare PtrSafe Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr, Optional ByVal dwRefData As LongPtr) As Long
Private Declare PtrSafe Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr) As Long

Private Type MSG
    hWnd        As LongPtr
    message     As Long
    wParam      As LongPtr
    lParam      As LongPtr
    Time        As Long
    PT          As POINT
End Type
Private Const PM_NOREMOVE           As Long = 0&
Private Const PM_REMOVE             As Long = 1&
'
Private Const CLR_NONE = &HFFFFFFFF
Private Const RDW_UPDATENOW As Long = &H100
Private Const RDW_INVALIDATE As Long = &H1
Private Const RDW_ERASE As Long = &H4
Private Const RDW_ALLCHILDREN As Long = &H80

Private Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersionl As Integer   ' e.g. = &h0000 = 0
   dwStrucVersionh As Integer   ' e.g. = &h0042 = .42
   dwFileVersionMSl As Integer   ' e.g. = &h0003 = 3
   dwFileVersionMSh As Integer   ' e.g. = &h0075 = .75
   dwFileVersionLSl As Integer   ' e.g. = &h0000 = 0
   dwFileVersionLSh As Integer   ' e.g. = &h0031 = .31
   dwProductVersionMSl As Integer   ' e.g. = &h0003 = 3
   dwProductVersionMSh As Integer   ' e.g. = &h0010 = .1
   dwProductVersionLSl As Integer   ' e.g. = &h0000 = 0
   dwProductVersionLSh As Integer   ' e.g. = &h0031 = .31
   dwFileFlagsMask As Long   ' = &h3F for version "0.42"
   dwFileFlags As Long   ' e.g. VFF_DEBUG Or VFF_PRERELEASE
   dwFileOS As Long   ' e.g. VOS_DOS_WINDOWS16
   dwFileType As Long   ' e.g. VFT_DRIVER
   dwFileSubtype As Long   ' e.g. VFT2_DRV_KEYBOARD
   dwFileDateMS As Long   ' e.g. 0
   dwFileDateLS As Long   ' e.g. 0
End Type
Private Type VS_VERSIONINFO_FIXED_PORTION
    wLength As Integer
    wValueLength As Integer
    wType As Integer
    szKey(1 To 16) As Integer   'Unicode "VS_VERSION_INFO" & vbNullChar.
    Padding1(1 To 1) As Integer 'Pad next field to DWORD boundary.
    Value As VS_FIXEDFILEINFO
End Type
Private Const RT_VERSION = 16

Private Enum ucst_SWP_Flags
    SWP_NOSIZE = &H1
    SWP_NOMOVE = &H2
    SWP_NOZORDER = &H4
    SWP_NOREDRAW = &H8
    SWP_NOACTIVATE = &H10
    SWP_FRAMECHANGED = &H20
    SWP_DRAWFRAME = &H20
    SWP_SHOWWINDOW = &H40
    SWP_HIDEWINDOW = &H80
    SWP_NOCOPYBITS = &H100
    SWP_NOREPOSITION = &H200
    SWP_NOSENDCHANGING = &H400
    
    SWP_DEFERERASE = &H2000
    SWP_ASYNCWINDOWPOS = &H4000
End Enum

Private Const SM_CYFRAME         As Long = 33
Private Const SM_CYCAPTION = 4

Private Const IDC_ARROW = 32512&
Private Const IDC_WAIT = 32514&

Private Const COLOR_WINDOWTEXT = 8

Private Const UNICODE_NOCHAR = &HFFFF

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90

Private Const LF_FACESIZE As Long = 32
Private Const FW_NORMAL As Long = 400
Private Const FW_BOLD As Long = 700
Private Const DEFAULT_QUALITY As Long = 0
Private Type LOGFONT
    LFHeight As Long
    LFWidth As Long
    LFEscapement As Long
    LFOrientation As Long
    LFWeight As Long
    LFItalic As Byte
    LFUnderline As Byte
    LFStrikeOut As Byte
    LFCharset As Byte
    LFOutPrecision As Byte
    LFClipPrecision As Byte
    LFQuality As Byte
    LFPitchAndFamily As Byte
    LFFaceName(0 To ((LF_FACESIZE * 2) - 1)) As Byte
End Type

Private Type DLLVERSIONINFO
    cbSize As Long
    dwMajor As Long
    dwMinor As Long
    dwBuildNumber As Long
    dwPlatformID As Long
End Type

Private Enum ucst_PMS_Flags
    PMSF_NORMAL = &H0
    PMSF_MULTIPLE = &H1
    PMSF_DONT_STRIP_SPACES = &H10000
End Enum

Private Enum ucst_IL_CreateFlags
  ILC_MASK = &H1
  ILC_COLOR = &H0
  ILC_COLORDDB = &HFE
  ILC_COLOR4 = &H4
  ILC_COLOR8 = &H8
  ILC_COLOR16 = &H10
  ILC_COLOR24 = &H18
  ILC_COLOR32 = &H20
  ILC_PALETTE = &H800                  ' (no longer supported...never worked anyway)
  '5.0
  ILC_MIRROR = &H2000
  ILC_PERITEMMIRROR = &H8000&
  '6.0
  ILC_ORIGINALSIZE = &H10000
  ILC_HIGHQUALITYSCALE = &H20000
End Enum

Private Const EM_SETSEL = &HB1
Private CF_SHELLIDLIST As Long
Private CF_DROPDESCRIPTION As Long
Private CF_PREFERREDDROPEFFECT As Long
Private CF_COMPUTEDDRAGIMAGE As Long
Private CF_INDRAGLOOP As Long

Private Enum ucst_SHGFI_flags
  SHGFI_LARGEICON = &H0            ' sfi.hIcon is large icon
  SHGFI_SMALLICON = &H1            ' sfi.hIcon is small icon
  SHGFI_OPENICON = &H2              ' sfi.hIcon is open icon
  SHGFI_SHELLICONSIZE = &H4      ' sfi.hIcon is shell size (not system size), rtns BOOL
  SHGFI_PIDL = &H8                        ' pszPath is pidl, rtns BOOL
  ' Indicates that the function should not attempt to access the file specified by pszPath.
  ' Rather, it should act as if the file specified by pszPath exists with the file attributes
  ' passed in dwFileAttributes. This flag cannot be combined with the SHGFI_ATTRIBUTES,
  ' SHGFI_EXETYPE, or SHGFI_PIDL flags <---- !!!
  SHGFI_USEFILEATTRIBUTES = &H10   ' pretend pszPath exists, rtns BOOL
  SHGFI_ICON = &H100                    ' fills sfi.hIcon, rtns BOOL, use DestroyIcon
  SHGFI_DISPLAYNAME = &H200    ' isf.szDisplayName is filled (SHGDN_NORMAL), rtns BOOL
  SHGFI_TYPENAME = &H400          ' isf.szTypeName is filled, rtns BOOL
  SHGFI_ATTRIBUTES = &H800         ' rtns IShellFolder::GetAttributesOf  SFGAO_* flags
  SHGFI_ICONLOCATION = &H1000   ' fills sfi.szDisplayName with filename
                                                        ' containing the icon, rtns BOOL
  SHGFI_EXETYPE = &H2000            ' rtns two ASCII chars of exe type
  SHGFI_SYSICONINDEX = &H4000   ' sfi.iIcon is sys il icon index, rtns hImagelist
  SHGFI_LINKOVERLAY = &H8000&    ' add shortcut overlay to sfi.hIcon
  SHGFI_SELECTED = &H10000        ' sfi.hIcon is selected icon
  SHGFI_ATTR_SPECIFIED = &H20000    ' get only attributes specified in sfi.dwAttributes
End Enum
Private Type SHFILEINFO   ' shfi
  hIcon As LongPtr
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type
Private Const NFR_UNICODE = 2
Private Const NM_FIRST As Long = 0&
Private Const NM_CLICK As Long = NM_FIRST - 2& 'uses NMCLICK struct
Private Const NM_DBLCLK As Long = NM_FIRST - 3&
Private Const NM_RETURN As Long = NM_FIRST - 4&
Private Const NM_RCLICK As Long = NM_FIRST - 5& 'uses NMCLICK struct
Private Const NM_RDBLCLK As Long = NM_FIRST - 6&
Private Const NM_CUSTOMDRAW As Long = NM_FIRST - 12&
Private Const WM_UNICHAR As Long = &H109
Private Const CDDS_PREPAINT As Long = &H1&
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Private Const CDRF_NOTIFYSUBITEMDRAW As Long = &H20&
Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Private Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)
Private Const CDDS_SUBITEM = &H20000

Private Const CDRF_NEWFONT As Long = &H2&
Private Const CDRF_DODEFAULT As Long = &H0&

Private Type EDITBALLOONTIP
    cbStruct As Long
    pszTitle As LongPtr
    pszText As LongPtr
    ttiIcon As ucst_BalloonTipIconConstants ' ; // From TTI_*
End Type
Private Const ECM_FIRST As Long = &H1500
Private Const EM_SHOWBALLOONTIP As Long = (ECM_FIRST + 3)
Private Enum ucst_BalloonTipIconConstants
   TTI_NONE = 0
   TTI_INFO = 1
   TTI_WARNING = 2
   TTI_ERROR = 3
End Enum

Private Const MK_CONTROL = 8
Private Const MK_LBUTTON = 1
Private Const MK_MBUTTON = &H10
Private Const MK_RBUTTON = 2
Private Const MK_SHIFT = 4
Private Const MK_XBUTTON1 = &H20
Private Const MK_XBUTTON2 = &H40
Private Enum ucst_TPM_wFlags
  TPM_LEFTBUTTON = &H0
  TPM_RIGHTBUTTON = &H2
  TPM_LEFTALIGN = &H0
  TPM_CENTERALIGN = &H4
  TPM_RIGHTALIGN = &H8
  TPM_TOPALIGN = &H0
  TPM_VCENTERALIGN = &H10
  TPM_BOTTOMALIGN = &H20

  TPM_HORIZONTAL = &H0         ' Horz alignment matters more
  TPM_VERTICAL = &H40            ' Vert alignment matters more
  TPM_NONOTIFY = &H80           ' Don't send any notification msgs
  TPM_RETURNCMD = &H100
  
  TPM_HORPOSANIMATION = &H400
  TPM_HORNEGANIMATION = &H800
  TPM_VERPOSANIMATION = &H1000
  TPM_VERNEGANIMATION = &H2000
  TPM_NOANIMATION = &H4000
End Enum
Private Enum ucst_SND_FLAGS
    SND_ALIAS = &H10000 ' name is a WIN.INI [sounds] entry
    SND_ALIAS_ID = &H110000 ' name is a WIN.INI [sounds]Entry identifier
    SND_ALIAS_START = 0 ' must be > 4096 to keep strings insame section of resource file
    SND_APPLICATION = &H80 ' look for applicationspecific association
    SND_ASYNC = &H1 ' play asynchronously
    SND_FILENAME = &H20000 ' name is a file name
    SND_LOOP = &H8 ' loop the sound until nextsndPlaySound
    SND_MEMORY = &H4 ' lpszSoundName points to a memoryFile
    SND_NODEFAULT = &H2 ' silence not default, if soundnot found
    SND_NOSTOP = &H10 ' don't stop any currently playingsound
    SND_NOWAIT = &H2000 ' don't wait if the driver is busy
    SND_PURGE = &H40 ' purge non-static events forTask
    SND_RESERVED = &HFF000000 ' In particular these flags areReserved
    SND_RESOURCE = &H40004 ' name is a resource name or atom
    SND_SYNC = &H0 ' play synchronously (default)
    SND_TYPE_MASK = &H170007
    SND_VALID = &H1F ' valid flags / ;Internal /
    SND_VALIDFLAGS = &H17201F ' Set of valid flag bits.
End Enum

Private Enum ucst_ShellImageListFlags
    SHIL_LARGE = &H0
    SHIL_SMALL = &H1
    SHIL_EXTRALARGE = &H2
    SHIL_SYSSMALL = &H3
    '6.0
    SHIL_JUMBO = &H4
    SHIL_LAST = &H5 'NOT AN IMAGELIST
End Enum

Private Enum ucst_TVItemCheckStates
    tvcsNoBox = 0
    tvcsEmpty = 1
    tvcsChecked = 2
    tvcsPartial = 3
    tvcsExclude = 4
    'if you wish to add more check states (besides dimmed selected)
End Enum

Private Const MAX_ITEM = 256

' ============================================
' TREEVIEW COMPLETE DEFINITIONS
' ============================================
Private Const CCM_FIRST = &H2000

Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1)   ' lParam is bkColor
Private Const CCM_SETCOLORSCHEME = (CCM_FIRST + 2)     ' lParam is color scheme
Private Const CCM_GETCOLORSCHEME = (CCM_FIRST + 3)     ' fills in COLORSCHEME pointed to by lParam
Private Const CCM_GETDROPTARGET = (CCM_FIRST + 4)
Private Const CCM_SETUNICODEFORMAT = (CCM_FIRST + 5)
Private Const CCM_GETUNICODEFORMAT = (CCM_FIRST + 6)
Private Const CCM_TRANSLATEACCELERATOR = &H461 '(WM_USER + 97)

Private Const IDD_TREEVIEW = 100

Private Enum ucst_TVHandles
  TVI_ROOT = &HFFFF0000
  TVI_FIRST = &HFFFF0001
  TVI_LAST = &HFFFF0002
  TVI_SORT = &HFFFF0003
End Enum

Private Const WC_TREEVIEW As String = "SysTreeView32"
' messages
Private Const I_CHILDRENCALLBACK = (-1)

Private Enum ucst_TVMessages
  TV_FIRST = &H1100
  
'#If UNICODE Then
  TVM_INSERTITEMW = (TV_FIRST + 50)
'#Else
  TVM_INSERTITEM = (TV_FIRST + 0)
'#End If
  
  TVM_DELETEITEM = (TV_FIRST + 1)
  TVM_EXPAND = (TV_FIRST + 2)
  TVM_GETITEMRECT = (TV_FIRST + 4)
  TVM_GETCOUNT = (TV_FIRST + 5)
  TVM_GETINDENT = (TV_FIRST + 6)
  TVM_SETINDENT = (TV_FIRST + 7)
  TVM_GETIMAGELIST = (TV_FIRST + 8)
  TVM_SETIMAGELIST = (TV_FIRST + 9)
  TVM_GETNEXTITEM = (TV_FIRST + 10)
  TVM_SELECTITEM = (TV_FIRST + 11)
  
'#If UNICODE Then
  TVM_GETITEMW = (TV_FIRST + 62)
  TVM_SETITEMW = (TV_FIRST + 63)
  TVM_EDITLABELW = (TV_FIRST + 65)
'#Else
  TVM_GETITEM = (TV_FIRST + 12)
  TVM_SETITEM = (TV_FIRST + 13)
  TVM_EDITLABEL = (TV_FIRST + 14)
'#End If
  
  TVM_GETEDITCONTROL = (TV_FIRST + 15)
  TVM_GETVISIBLECOUNT = (TV_FIRST + 16)
  TVM_HITTEST = (TV_FIRST + 17)
  TVM_CREATEDRAGIMAGE = (TV_FIRST + 18)
  TVM_SORTCHILDREN = (TV_FIRST + 19)
  TVM_ENSUREVISIBLE = (TV_FIRST + 20)
  TVM_SORTCHILDRENCB = (TV_FIRST + 21)
  TVM_ENDEDITLABELNOW = (TV_FIRST + 22)
  
'#If UNICODE Then
  TVM_GETISEARCHSTRINGW = (TV_FIRST + 64)
'#Else
  TVM_GETISEARCHSTRING = (TV_FIRST + 23)
'#End If
  
  TVM_SETTOOLTIPS = (TV_FIRST + 24)
  TVM_GETTOOLTIPS = (TV_FIRST + 25)
  TVM_SETINSERTMARK = (TV_FIRST + 26)
  TVM_SETUNICODEFORMAT = CCM_SETUNICODEFORMAT
  TVM_GETUNICODEFORMAT = CCM_GETUNICODEFORMAT
  TVM_SETITEMHEIGHT = (TV_FIRST + 27)
  TVM_GETITEMHEIGHT = (TV_FIRST + 28)
  TVM_SETBKCOLOR = (TV_FIRST + 29)
  TVM_SETTEXTCOLOR = (TV_FIRST + 30)
  TVM_GETBKCOLOR = (TV_FIRST + 31)
  TVM_GETTEXTCOLOR = (TV_FIRST + 32)
  TVM_SETSCROLLTIME = (TV_FIRST + 33)
  TVM_GETSCROLLTIME = (TV_FIRST + 34)
  TVM_SETBORDER = (TV_FIRST + 35)

  TVM_SETINSERTMARKCOLOR = (TV_FIRST + 37)
  TVM_GETINSERTMARKCOLOR = (TV_FIRST + 38)
  '5.0
  TVM_GETITEMSTATE = (TV_FIRST + 39)
  TVM_SETLINECOLOR = (TV_FIRST + 40)
  TVM_GETLINECOLOR = (TV_FIRST + 41)
  TVM_MAPACCIDTOHTREEITEM = (TV_FIRST + 42)
  TVM_MAPHTREEITEMTOACCID = (TV_FIRST + 43)
  TVM_SETEXTENDEDSTYLE = (TV_FIRST + 44)
  TVM_GETEXTENDEDSTYLE = (TV_FIRST + 45)
  TVM_SETHOT = (TV_FIRST + 58)
  TVM_SETAUTOSCROLLINFO = (TV_FIRST + 59)
  '6.0
  TVM_GETSELECTEDCOUNT = (TV_FIRST + 70)
  TVM_SHOWINFOTIP = (TV_FIRST + 71)
  TVM_GETITEMPARTRECT = (TV_FIRST + 72)
    
End Enum   ' TVMessages

Private Enum ucst_TV_Styles
    TVS_HASBUTTONS = &H1
    TVS_HASLINES = &H2
    TVS_LINESATROOT = &H4
    TVS_EDITLABELS = &H8
    TVS_DISABLEDRAGDROP = &H10
    TVS_SHOWSELALWAYS = &H20
    TVS_RTLREADING = &H40
    TVS_NOTOOLTIPS = &H80
    TVS_CHECKBOXES = &H100
    TVS_TRACKSELECT = &H200
    TVS_SINGLEEXPAND = &H400
    TVS_INFOTIP = &H800
    TVS_FULLROWSELECT = &H1000
    TVS_NOSCROLL = &H2000
    TVS_NONEVENHEIGHT = &H4000
    TVS_NOHSCROLL = &H8000&
End Enum
Private Enum ucst_TV_Ex_Styles
    TVS_EX_NOSINGLECOLLAPSE = &H1
    TVS_EX_MULTISELECT = &H2
    TVS_EX_DOUBLEBUFFER = &H4
    TVS_EX_NOINDENTSTATE = &H8
    TVS_EX_RICHTOOLTIP = &H10
    TVS_EX_AUTOHSCROLL = &H20
    TVS_EX_FADEINOUTEXPANDOS = &H40
    TVS_EX_PARTIALCHECKBOXES = &H80
    TVS_EX_EXCLUSIONCHECKBOXES = &H100
    TVS_EX_DIMMEDCHECKBOXES = &H200
    TVS_EX_DRAWIMAGEASYNC = &H400
End Enum

Private Enum ucst_TVSB_Flags
    TVSBF_XBORDER = &H1
    TVSBF_YBORDER = &H2
End Enum
' TVM_GET/SETIMAGELIST wParam
Private Enum ucst_TVImageLists
    TVSIL_NORMAL = 0
    TVSIL_STATE = 2
End Enum

' TVM_GETNEXTITEM wParam
Private Enum ucst_TVM_GETNEXTITEM_wParam
  TVGN_ROOT = &H0
  TVGN_NEXT = &H1
  TVGN_PREVIOUS = &H2
  TVGN_PARENT = &H3
  TVGN_CHILD = &H4
  TVGN_FIRSTVISIBLE = &H5
  TVGN_NEXTVISIBLE = &H6
  TVGN_PREVIOUSVISIBLE = &H7
  TVGN_DROPHILITE = &H8
  TVGN_CARET = &H9
  TVGN_LASTVISIBLE = &HA
  TVGN_NEXTSELECTED = &HB
End Enum

Private Const TVSI_NOSINGLEEXPAND = &H8000

' TVM_GET/SETITEM lParam
Private Type TVITEM   'TVITEMW
  Mask As ucst_TVITEM_Mask
  hItem As LongPtr
  State As ucst_TVITEM_State
  StateMask As ucst_TVITEM_State
  pszText As LongPtr
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As LongPtr
End Type
Private Type TVITEMA   ' was TV_ITEM
  Mask As ucst_TVITEM_Mask
  hItem As LongPtr
  State As ucst_TVITEM_State
  StateMask As ucst_TVITEM_State
  pszText As String    ' if a string, must be pre-allocated!!
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As LongPtr
End Type

Private Type TVITEMEX 'TVITEMEXW
    Mask As ucst_TVITEM_Mask
    hItem As LongPtr
    State As ucst_TVITEM_State
    StateMask As ucst_TVITEM_State
    pszText As LongPtr
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As LongPtr
    iIntegral As Long
    uStateEx As ucst_TVITEM_State_Ex
    hWnd As LongPtr
    iExpandedImage As Long
    iReserved As Long 'Win7
End Type
Private Type TVITEMEXA
    Mask As ucst_TVITEM_Mask
    hItem As LongPtr
    State As ucst_TVITEM_State
    StateMask As ucst_TVITEM_State
    pszText As String
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As LongPtr
    iIntegral As Long
    uStateEx As ucst_TVITEM_State_Ex
    hWnd As LongPtr
    iExpandedImage As Long
    iReserved As Long 'Win7
End Type

'TVINSERTSTRUCT is supposed to be a union where item is TVITEMA/W or EXA/EXW
'but VB doesn't support unions or 'As Any' in structs. Macros using these
'also had to be duplicated
Private Type TVINSERTSTRUCT
    hParent As LongPtr
    hInsertAfter As LongPtr
    Item As TVITEM
End Type
Private Type TVINSERTSTRUCTEX
    hParent As LongPtr
    hInsertAfter As LongPtr
    Item As TVITEMEX
End Type

Private Enum ucst_TVITEMPART
    TVGIPR_BUTTON = &H1
End Enum

Private Type TVGETITEMPARTRECTINFO
    hti As LongPtr
    prc As RECT
    partid As ucst_TVITEMPART
End Type

' TVITEM mask
Private Enum ucst_TVITEM_Mask
    TVIF_TEXT = &H1
    TVIF_IMAGE = &H2
    TVIF_PARAM = &H4
    TVIF_STATE = &H8
    TVIF_HANDLE = &H10
    TVIF_SELECTEDIMAGE = &H20
    TVIF_CHILDREN = &H40
    TVIF_INTEGRAL = &H80
    '6.0
    TVIF_STATEEX = &H100
    TVIF_EXPANDEDIMAGE = &H200
    TVIF_DI_SETITEM = &H1000
End Enum
' TVITEM state, stateMask
Private Enum ucst_TVITEM_State
    TVIS_SELECTED = &H2
    TVIS_CUT = &H4
    TVIS_DROPHILITED = &H8
    TVIS_BOLD = &H10
    TVIS_EXPANDED = &H20
    TVIS_EXPANDEDONCE = &H40
    TVIS_EXPANDPARTIAL = &H80
    TVIS_OVERLAYMASK = &HF00
    TVIS_STATEIMAGEMASK = &HF000&
    TVIS_USERMASK = &HF000&
End Enum
Private Enum ucst_TVITEM_State_Ex
    '6.0
    TVIS_EX_FLAT = &H1
    TVIS_EX_DISABLED = &H2
    TVIS_EX_ALL = &H2
End Enum
' TVM_HITTEST lParam
Private Type TVHITTESTINFO   ' was TV_HITTESTINFO
  PT As POINT
  Flags As ucst_TVHT_flags
  hItem As LongPtr
End Type

Private Enum ucst_TVHT_flags
  TVHT_NOWHERE = &H1   ' In the client area, but below the last item
  TVHT_ONITEMICON = &H2
  TVHT_ONITEMLABEL = &H4
  TVHT_ONITEMINDENT = &H8
  TVHT_ONITEMBUTTON = &H10
  TVHT_ONITEMRIGHT = &H20
  TVHT_ONITEMSTATEICON = &H40
  TVHT_ONITEM = (TVHT_ONITEMICON Or TVHT_ONITEMLABEL Or TVHT_ONITEMSTATEICON)
  
  TVHT_ABOVE = &H100
  TVHT_BELOW = &H200
  TVHT_TORIGHT = &H400
  TVHT_TOLEFT = &H800
  
  ' user-defined
  TVHT_ONITEMLINE = (TVHT_ONITEM Or TVHT_ONITEMINDENT Or TVHT_ONITEMBUTTON Or TVHT_ONITEMRIGHT)
End Enum

' TVM_SORTCHILDRENCB lParam
Private Type TVSORTCB   ' was TV_SORTCB
  hParent As LongPtr
  lpfnCompare As LongPtr
  lParam As LongPtr
End Type
Private Enum ucst_TVM_EXPAND_wParam
  TVE_COLLAPSE = &H1
  TVE_EXPAND = &H2
  TVE_TOGGLE = &H3

  TVE_EXPANDPARTIAL = &H4000
  
  TVE_COLLAPSERESET = &H8000&
End Enum
Private Const TVC_UNKNOWN = &H0
Private Const TVC_BYMOUSE = &H1
Private Const TVC_BYKEYBOARD = &H2

' notifications
Private Enum ucst_TVNotifications
  TVN_FIRST = -400&   ' &HFFFFFE70   ' (0U-400U)
  TVN_LAST = -499&    ' &HFFFFFE0D    ' (0U-499U)
                                                      ' lParam points to:
  TVN_SELCHANGINGA = (TVN_FIRST - 1)          ' NMTREEVIEW
  TVN_SELCHANGEDA = (TVN_FIRST - 2)           ' NMTREEVIEW
  TVN_GETDISPINFOA = (TVN_FIRST - 3)            ' NMTVDISPINFO
  TVN_SETDISPINFOA = (TVN_FIRST - 4)            ' NMTVDISPINFO
  TVN_ITEMEXPANDINGA = (TVN_FIRST - 5)       ' NMTREEVIEW
  TVN_ITEMEXPANDEDA = (TVN_FIRST - 6)        ' NMTREEVIEW
  TVN_BEGINDRAGA = (TVN_FIRST - 7)              ' NMTREEVIEW
  TVN_BEGINRDRAGA = (TVN_FIRST - 8)            ' NMTREEVIEW
  TVN_DELETEITEMA = (TVN_FIRST - 9)             ' NMTREEVIEW
  TVN_BEGINLABELEDITA = (TVN_FIRST - 10)    ' NMTVDISPINFO
  TVN_ENDLABELEDITA = (TVN_FIRST - 11)       ' NMTVDISPINFO
  TVN_KEYDOWN = (TVN_FIRST - 12)                ' NMTVKEYDOWN

  TVN_SELCHANGINGW = (TVN_FIRST - 50)
  TVN_SELCHANGEDW = (TVN_FIRST - 51)
  TVN_GETDISPINFOW = (TVN_FIRST - 52)
  TVN_SETDISPINFOW = (TVN_FIRST - 53)
  TVN_ITEMEXPANDINGW = (TVN_FIRST - 54)
  TVN_ITEMEXPANDEDW = (TVN_FIRST - 55)
  TVN_BEGINDRAGW = (TVN_FIRST - 56)
  TVN_BEGINRDRAGW = (TVN_FIRST - 57)
  TVN_DELETEITEMW = (TVN_FIRST - 58)
  TVN_BEGINLABELEDITW = (TVN_FIRST - 59)
  TVN_ENDLABELEDITW = (TVN_FIRST - 60)

  TVN_GETINFOTIPA = (TVN_FIRST - 13)
  TVN_GETINFOTIPW = (TVN_FIRST - 14)
  TVN_SINGLEEXPAND = (TVN_FIRST - 15)
    TVN_ITEMCHANGINGA = (TVN_FIRST - 16)
    TVN_ITEMCHANGINGW = (TVN_FIRST - 17)
    TVN_ITEMCHANGEDA = (TVN_FIRST - 18)
    TVN_ITEMCHANGEDW = (TVN_FIRST - 19)
    TVN_ASYNCDRAW = (TVN_FIRST - 20)

End Enum   ' Notifications

Private Const TVNRET_DEFAULT = &H0
Private Const TVNRET_SKIPOLD = &H1
Private Const TVNRET_SKIPNEW = &H2

' lParam for most treeview notification messages
Private Type NMTREEVIEW   ' was NM_TREEVIEW
  hdr As NMHDR
  ' Specifies a notification-specific action flag.
  ' Is TVC_* for TVN_SELCHANGING, TVN_SELCHANGED, TVN_SETDISPINFO
  ' Is TVE_* for TVN_ITEMEXPANDING, TVN_ITEMEXPANDED
  Action As Long
  itemOld As TVITEM
  itemNew As TVITEM
  ptDrag As POINT
End Type
Private Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDC As LongPtr
    RC As RECT
    dwItemSpec As LongPtr
    uItemState As Long
    lItemlParam As LongPtr
End Type
Private Type NMTVSTATEIMAGECHANGING
    hdr As NMHDR
    hti As LongPtr
    iOldStateImageIndex As Long
    iNewStateImageIndex As Long
End Type
Private Type NMTVDISPINFO
    hdr As NMHDR
    Item As TVITEM
End Type
Private Type NMTVDISPINFOEX
    hdr As NMHDR
    Item As TVITEMEX
End Type
Private Type NMTVKEYDOWN
    hdr As NMHDR
    wVKey As Integer
    Flags As Long
End Type
Private Const TVCDRF_NOIMAGES = &H10000
Private Type NMTVCUSTOMDRAW
    NMCD As NMCUSTOMDRAW
    ClrText As Long
    ClrTextBk As Long
    iLevel As Long
End Type
Private Type NMTVGETINFOTIP
    hdr As NMHDR
    pszText As LongPtr
    cchTextMax As Long
    hItem As LongPtr
    lParam As LongPtr
End Type
Private Type NMTVITEMCHANGE
    hdr As NMHDR
    uChanged As Long
    hItem As LongPtr
    uStateNew As ucst_TVITEM_State
    uStateOld As ucst_TVITEM_State
    lParam As LongPtr
End Type
Private Type NMTVASYNCDRAW
    hdr As NMHDR
    pimldp As IMAGELISTDRAWPARAMS
    hr As Long
    hItem As LongPtr
    lParam As LongPtr
    dwRetFlags As Long
    iRetImageIndex As Long
End Type

Private Type MENUITEMINFOW
  cbSize As Long
  fMask As ucst_MII_Mask
  fType As ucst_MF_Type              ' MIIM_TYPE
  fState As ucst_MF_State             ' MIIM_STATE
  wID As Long                       ' MIIM_ID
  hSubMenu As LongPtr            ' MIIM_SUBMENU
  hbmpChecked As LongPtr      ' MIIM_CHECKMARKS
  hbmpUnchecked As LongPtr  ' MIIM_CHECKMARKS
  dwItemData As LongPtr          ' MIIM_DATA
  dwTypeData As LongPtr        ' MIIM_TYPE
  cch As Long                       ' MIIM_TYPE
  hbmpItem As LongPtr
End Type
Private Enum ucst_MII_Mask
  MIIM_STATE = &H1
  MIIM_ID = &H2
  MIIM_SUBMENU = &H4
  MIIM_CHECKMARKS = &H8
  MIIM_TYPE = &H10
  MIIM_DATA = &H20
  MIIM_BITMAP = &H80
  MIIM_STRING = &H40
End Enum
Private Enum ucst_MenuFlags
  MF_INSERT = &H0
  MF_ENABLED = &H0
  MF_UNCHECKED = &H0
  MF_BYCOMMAND = &H0
  MF_STRING = &H0
  MF_UNHILITE = &H0
  MF_GRAYED = &H1
  MF_DISABLED = &H2
  MF_BITMAP = &H4
  MF_CHECKED = &H8
  MF_POPUP = &H10
  MF_MENUBARBREAK = &H20
  MF_MENUBREAK = &H40
  MF_HILITE = &H80
  MF_CHANGE = &H80
  MF_END = &H80                    ' Obsolete -- only used by old RES files
  MF_APPEND = &H100
  MF_OWNERDRAW = &H100
  MF_DELETE = &H200
  MF_USECHECKBITMAPS = &H200
  MF_BYPOSITION = &H400
  MF_SEPARATOR = &H800
  MF_REMOVE = &H1000
  MF_DEFAULT = &H1000
  MF_SYSMENU = &H2000
  MF_HELP = &H4000
  MF_RIGHTJUSTIFY = &H4000
  MF_MOUSESELECT = &H8000&
End Enum

Private Enum ucst_MF_Type
  MFT_STRING = MF_STRING
  MFT_BITMAP = MF_BITMAP
  MFT_MENUBARBREAK = MF_MENUBARBREAK
  MFT_MENUBREAK = MF_MENUBREAK
  MFT_OWNERDRAW = MF_OWNERDRAW
  MFT_RADIOCHECK = &H200
  MFT_SEPARATOR = MF_SEPARATOR
  MFT_RIGHTORDER = &H2000
  MFT_RIGHTJUSTIFY = MF_RIGHTJUSTIFY
End Enum
Private Enum ucst_MF_State
  MFS_GRAYED = &H3
  MFS_DISABLED = MFS_GRAYED
  MFS_CHECKED = MF_CHECKED
  MFS_HILITE = MF_HILITE
  MFS_ENABLED = MF_ENABLED
  MFS_UNCHECKED = MF_UNCHECKED
  MFS_UNHILITE = MF_UNHILITE
  MFS_DEFAULT = MF_DEFAULT
End Enum

#If TWINBASIC Then
#If Win64 = 0 Then
[PackingAlignment(1)]
#End If
Public Type SHFILEOPSTRUCT
    hWnd        As LongPtr
    wFunc       As FILEOP
    pFrom       As LongPtr
    pTo         As LongPtr
    #If Win64 Then
    fFlags As FILEOP_FLAGS 'We can use this trick since on Win64, this UDT isn't byte-packed
    #Else
    /* [ TypeHint(FILEOP_FLAGS) */ fFlags      As Integer
    #End If
    fAnyOperationsAborted    As BOOL
    hNameMappings   As LongPtr
    lpszProgressTitle   As LongPtr
End Type
#Else
Private Type SHFILEOPSTRUCT
   hWnd        As LongPtr
   wFunc       As FILEOP
   pFrom       As LongPtr
   pTo         As LongPtr
   fFlags      As FILEOP_FLAGS
   fAborted    As Boolean
   'Members below this point invalid on VB6
   hNameMaps   As LongPtr
   lpszProgressTitle   As LongPtr
 End Type
#End If

#End Region

#Region "IPAO"

'IPAO hooking code courtesy of Krool's VBCCR project

Private Enum VTableInterfaceConstants
VTableInterfaceInPlaceActiveObject = 1
VTableInterfaceControl = 2
VTableInterfacePerPropertyBrowsing = 3
End Enum
Private Type VTableIPAODataStruct
VTable As LongPtr
RefCount As Long
OriginalIOleIPAO As IOleInPlaceActiveObject
IOleIPAO As IOleInPlaceActiveObjectVB
End Type
Private Type VTableEnumVARIANTDataStruct
VTable As LongPtr
RefCount As Long
Enumerable As Object
Index As Long
Count As Long
End Type
Private Const CTRLINFO_EATS_RETURN As Long = 1
Private Const CTRLINFO_EATS_ESCAPE As Long = 2
Private Declare PtrSafe Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)

Private VTableIPAO(0 To 9) As LongPtr, VTableIPAOData As VTableIPAODataStruct

Private Function SetVTableHandling(ByVal This As Object, ByVal OLEInterface As VTableInterfaceConstants) As Boolean
Select Case OLEInterface
    Case VTableInterfaceInPlaceActiveObject
        If VTableHandlingSupported(This, VTableInterfaceInPlaceActiveObject) = True Then
            VTableIPAOData.RefCount = VTableIPAOData.RefCount + 1
            SetVTableHandling = True
        End If
'    Case VTableInterfaceControl
'        If VTableHandlingSupported(This, VTableInterfaceControl) = True Then
'            Call ReplaceIOleControl(This)
'            SetVTableHandling = True
'        End If
'    Case VTableInterfacePerPropertyBrowsing
'        If VTableHandlingSupported(This, VTableInterfacePerPropertyBrowsing) = True Then
'            Call ReplaceIPPB(This)
'            SetVTableHandling = True
'        End If
End Select
End Function

Private Function RemoveVTableHandling(ByVal This As Object, ByVal OLEInterface As VTableInterfaceConstants) As Boolean
Select Case OLEInterface
    Case VTableInterfaceInPlaceActiveObject
        If VTableHandlingSupported(This, VTableInterfaceInPlaceActiveObject) = True Then
            VTableIPAOData.RefCount = VTableIPAOData.RefCount - 1
            RemoveVTableHandling = True
        End If
'    Case VTableInterfaceControl
'        If VTableHandlingSupported(This, VTableInterfaceControl) = True Then
'            Call RestoreIOleControl(This)
'            RemoveVTableHandling = True
'        End If
'    Case VTableInterfacePerPropertyBrowsing
'        If VTableHandlingSupported(This, VTableInterfacePerPropertyBrowsing) = True Then
'            Call RestoreIPPB(This)
'            RemoveVTableHandling = True
'        End If
End Select
End Function
Private Function VTableHandlingSupported(ByRef This As Object, ByVal OLEInterface As VTableInterfaceConstants) As Boolean
On Error GoTo CATCH_EXCEPTION
Select Case OLEInterface
    Case VTableInterfaceInPlaceActiveObject
        Dim ShadowIOleIPAO As IOleInPlaceActiveObject
        Dim ShadowIOleInPlaceActiveObjectVB As IOleInPlaceActiveObjectVB
        Set ShadowIOleIPAO = This
        Set ShadowIOleInPlaceActiveObjectVB = This
        VTableHandlingSupported = Not CBool(ShadowIOleIPAO Is Nothing Or ShadowIOleInPlaceActiveObjectVB Is Nothing)
'    Case VTableInterfaceControl
'        Dim ShadowIOleControl As OLEGuids.IOleControl
'        Dim ShadowIOleControlVB As OLEGuids.IOleControlVB
'        Set ShadowIOleControl = This
'        Set ShadowIOleControlVB = This
'        VTableHandlingSupported = Not CBool(ShadowIOleControl Is Nothing Or ShadowIOleControlVB Is Nothing)
'    Case VTableInterfacePerPropertyBrowsing
'        Dim ShadowIPPB As OLEGuids.IPerPropertyBrowsing
'        Dim ShadowIPerPropertyBrowsingVB As OLEGuids.IPerPropertyBrowsingVB
'        Set ShadowIPPB = This
'        Set ShadowIPerPropertyBrowsingVB = This
'        VTableHandlingSupported = Not CBool(ShadowIPPB Is Nothing Or ShadowIPerPropertyBrowsingVB Is Nothing)
End Select
CATCH_EXCEPTION:
End Function

Private Sub ActivateIPAO(ByVal This As Object)
On Error GoTo CATCH_EXCEPTION
Dim PropOleObject As IOleObject
Dim PropOleInPlaceSite As IOleInPlaceSite
Dim PropOleInPlaceFrame As IOleInPlaceFrame
Dim PropOleInPlaceUIWindow As IOleInPlaceUIWindow
Dim PropOleInPlaceActiveObject As IOleInPlaceActiveObject
Dim PosRect As OLERECT
Dim ClipRect As OLERECT
Dim FrameInfo As OLEINPLACEFRAMEINFO
Set PropOleObject = This
If VTableIPAOData.RefCount > 0 Then
    With VTableIPAOData
    .VTable = GetVTableIPAO()
    Set .OriginalIOleIPAO = This
    Set .IOleIPAO = This
    End With
    CopyMemory ByVal VarPtr(PropOleInPlaceActiveObject), VarPtr(VTableIPAOData), LenB(VTableIPAOData.VTable)
    PropOleInPlaceActiveObject.AddRef
Else
    Set PropOleInPlaceActiveObject = This
End If
Set PropOleInPlaceSite = PropOleObject.GetClientSite
PropOleInPlaceSite.GetWindowContext PropOleInPlaceFrame, PropOleInPlaceUIWindow, VarPtr(PosRect), VarPtr(ClipRect), VarPtr(FrameInfo)
PropOleInPlaceFrame.SetActiveObject PropOleInPlaceActiveObject, vbNullString
If Not PropOleInPlaceUIWindow Is Nothing Then PropOleInPlaceUIWindow.SetActiveObject PropOleInPlaceActiveObject, vbNullString
CATCH_EXCEPTION:
End Sub

Private Sub DeActivateIPAO()
On Error GoTo CATCH_EXCEPTION
If VTableIPAOData.OriginalIOleIPAO Is Nothing Then Exit Sub
Dim PropOleObject As IOleObject
Dim PropOleInPlaceSite As IOleInPlaceSite
Dim PropOleInPlaceFrame As IOleInPlaceFrame
Dim PropOleInPlaceUIWindow As IOleInPlaceUIWindow
Dim PosRect As OLERECT
Dim ClipRect As OLERECT
Dim FrameInfo As OLEINPLACEFRAMEINFO
Set PropOleObject = VTableIPAOData.OriginalIOleIPAO
Set PropOleInPlaceSite = PropOleObject.GetClientSite
PropOleInPlaceSite.GetWindowContext PropOleInPlaceFrame, PropOleInPlaceUIWindow, VarPtr(PosRect), VarPtr(ClipRect), VarPtr(FrameInfo)
PropOleInPlaceFrame.SetActiveObject Nothing, vbNullString
If Not PropOleInPlaceUIWindow Is Nothing Then PropOleInPlaceUIWindow.SetActiveObject Nothing, vbNullString
CATCH_EXCEPTION:
Set VTableIPAOData.OriginalIOleIPAO = Nothing
Set VTableIPAOData.IOleIPAO = Nothing
End Sub

Private Function GetVTableIPAO() As LongPtr
If VTableIPAO(0) = 0 Then
    VTableIPAO(0) = ProcPtr(AddressOf IOleIPAO_QueryInterface)
    VTableIPAO(1) = ProcPtr(AddressOf IOleIPAO_AddRef)
    VTableIPAO(2) = ProcPtr(AddressOf IOleIPAO_Release)
    VTableIPAO(3) = ProcPtr(AddressOf IOleIPAO_GetWindow)
    VTableIPAO(4) = ProcPtr(AddressOf IOleIPAO_ContextSensitiveHelp)
    VTableIPAO(5) = ProcPtr(AddressOf IOleIPAO_TranslateAccelerator)
    VTableIPAO(6) = ProcPtr(AddressOf IOleIPAO_OnFrameWindowActivate)
    VTableIPAO(7) = ProcPtr(AddressOf IOleIPAO_OnDocWindowActivate)
    VTableIPAO(8) = ProcPtr(AddressOf IOleIPAO_ResizeBorder)
    VTableIPAO(9) = ProcPtr(AddressOf IOleIPAO_EnableModeless)
End If
GetVTableIPAO = VarPtr(VTableIPAO(0))
End Function

Private Function IOleIPAO_QueryInterface(ByRef This As VTableIPAODataStruct, ByRef IID As OLECLSID, ByRef pvObj As LongPtr) As Long
If VarPtr(pvObj) = 0 Then
    IOleIPAO_QueryInterface = E_POINTER
    Exit Function
End If
' IID_IOleInPlaceActiveObject = {00000117-0000-0000-C000-000000000046}
If IID.Data1 = &H117 And IID.Data2 = &H0 And IID.Data3 = &H0 Then
    If IID.Data4(0) = &HC0 And IID.Data4(1) = &H0 And IID.Data4(2) = &H0 And IID.Data4(3) = &H0 _
    And IID.Data4(4) = &H0 And IID.Data4(5) = &H0 And IID.Data4(6) = &H0 And IID.Data4(7) = &H46 Then
        pvObj = VarPtr(This)
        IOleIPAO_AddRef This
        IOleIPAO_QueryInterface = S_OK
    Else
        This.OriginalIOleIPAO.QueryInterface(IID, pvObj)
        IOleIPAO_QueryInterface = Err.LastHresult
    End If
Else
    This.OriginalIOleIPAO.QueryInterface(IID, pvObj)
    IOleIPAO_QueryInterface = Err.LastHresult
End If
End Function

Private Function IOleIPAO_AddRef(ByRef This As VTableIPAODataStruct) As Long
This.OriginalIOleIPAO.AddRef
IOleIPAO_AddRef = Err.LastHresult
End Function

Private Function IOleIPAO_Release(ByRef This As VTableIPAODataStruct) As Long
This.OriginalIOleIPAO.Release
IOleIPAO_Release = Err.LastHresult
End Function

Private Function IOleIPAO_GetWindow(ByRef This As VTableIPAODataStruct, ByRef hWnd As LongPtr) As Long
This.OriginalIOleIPAO.GetWindow(hWnd)
IOleIPAO_GetWindow = Err.LastHresult
End Function

Private Function IOleIPAO_ContextSensitiveHelp(ByRef This As VTableIPAODataStruct, ByVal EnterMode As Long) As Long
This.OriginalIOleIPAO.ContextSensitiveHelp(EnterMode)
IOleIPAO_ContextSensitiveHelp = Err.LastHresult
End Function

Private Function IOleIPAO_TranslateAccelerator(ByRef This As VTableIPAODataStruct, ByRef Msg As MSG) As Long
If VarPtr(Msg) = 0 Then
    IOleIPAO_TranslateAccelerator = E_INVALIDARG
    Exit Function
End If
On Error GoTo CATCH_EXCEPTION
Dim Handled As Boolean
IOleIPAO_TranslateAccelerator = S_OK
This.IOleIPAO.TranslateAccelerator Handled, IOleIPAO_TranslateAccelerator, Msg.hWnd, Msg.message, Msg.wParam, Msg.lParam, GetShiftStateFromMsg()
If Handled = False Then
    This.OriginalIOleIPAO.TranslateAccelerator(VarPtr(Msg))
    IOleIPAO_TranslateAccelerator = Err.LastHresult
End If
Exit Function
CATCH_EXCEPTION:
    This.OriginalIOleIPAO.TranslateAccelerator(VarPtr(Msg))
    IOleIPAO_TranslateAccelerator = Err.LastHresult
End Function

Private Function IOleIPAO_OnFrameWindowActivate(ByRef This As VTableIPAODataStruct, ByVal Activate As Long) As Long
This.OriginalIOleIPAO.OnFrameWindowActivate(Activate)
IOleIPAO_OnFrameWindowActivate = Err.LastHresult
End Function

Private Function IOleIPAO_OnDocWindowActivate(ByRef This As VTableIPAODataStruct, ByVal Activate As Long) As Long
This.OriginalIOleIPAO.OnDocWindowActivate(Activate)
IOleIPAO_OnDocWindowActivate = Err.LastHresult
End Function

Private Function IOleIPAO_ResizeBorder(ByRef This As VTableIPAODataStruct, ByRef RC As OLERECT, ByVal UIWindow As IOleInPlaceUIWindow, ByVal FrameWindow As Long) As Long
This.OriginalIOleIPAO.ResizeBorder(VarPtr(RC), UIWindow, FrameWindow)
IOleIPAO_ResizeBorder = Err.LastHresult
End Function

Private Function IOleIPAO_EnableModeless(ByRef This As VTableIPAODataStruct, ByVal Enable As Long) As Long
This.OriginalIOleIPAO.EnableModeless(Enable)
IOleIPAO_EnableModeless = Err.LastHresult
End Function


Private Function ProcPtr(ByVal Address As LongPtr) As LongPtr
ProcPtr = Address
End Function
Private Function GetShiftStateFromMsg() As ShiftConstants
If GetKeyState(vbKeyShift) < 0 Then GetShiftStateFromMsg = vbShiftMask
If GetKeyState(vbKeyControl) < 0 Then GetShiftStateFromMsg = GetShiftStateFromMsg Or vbCtrlMask
If GetKeyState(vbKeyMenu) < 0 Then GetShiftStateFromMsg = GetShiftStateFromMsg Or vbAltMask
End Function
#End Region

Private Sub DebugAppend(ByVal sMsg As String, Optional ilvl As Long)
If ilvl < 0 Then Exit Sub
If ilvl < dbg_MinLevel Then Exit Sub
If dbg_IncludeDate Then sMsg = "[ST][" & Format$(Now, "yyyy-mm-dd Hh:Mm:Ss") & "] " & sMsg 'yyyy-mm-dd
If dbg_PrintToImmediate Then Debug.Print sMsg
If dbg_RaiseEvent Then RaiseEvent DebugMessage(sMsg, CInt(ilvl))
End Sub

Private Function TreeView_SetImageList(hwnd As LongPtr, himl As LongPtr, iImage As ucst_TVImageLists) As LongPtr
  TreeView_SetImageList = SendMessage(hwnd, TVM_SETIMAGELIST, ByVal iImage, ByVal himl)
End Function

Private Function TreeView_GetImageList(hwnd As LongPtr) As LongPtr
TreeView_GetImageList = SendMessage(hwnd, TVM_GETIMAGELIST, 0, ByVal 0&)
End Function

Private Function TreeView_GetIndent(hwnd As LongPtr) As Long
TreeView_GetIndent = CLng(SendMessage(hwnd, TVM_GETINDENT, 0, ByVal 0&))
End Function

Private Function TreeView_SetIndent(hwnd As LongPtr, indent As Long) As Long
TreeView_SetIndent = CLng(SendMessage(hwnd, TVM_SETINDENT, indent, ByVal 0&))
End Function

Private Function TreeView_GetISearchString(hwnd As LongPtr, lpsz As LongPtr) As Long
TreeView_GetISearchString = CLng(SendMessage(hwnd, TVM_GETISEARCHSTRING, 0, ByVal lpsz))
End Function

Private Function TreeView_SetToolTips(hwnd As LongPtr, hwndTT As LongPtr) As LongPtr
TreeView_SetToolTips = SendMessage(hwnd, TVM_SETTOOLTIPS, hwndTT, ByVal 0&)
End Function

Private Function TreeView_GetToolTips(hwnd As LongPtr) As LongPtr
TreeView_GetToolTips = SendMessage(hwnd, TVM_GETTOOLTIPS, 0, ByVal 0&)
End Function

Private Function TreeView_GetItemPartRect(hwnd As LongPtr, hItem As LongPtr, prc As RECT, partid As ucst_TVITEMPART) As Long
Dim tInfo As TVGETITEMPARTRECTINFO
tInfo.hti = hItem
tInfo.prc = prc
tInfo.partid = partid
TreeView_GetItemPartRect = CLng(SendMessage(hwnd, TVM_GETITEMPARTRECT, 0, tInfo))

End Function

Private Function TreeView_GetItemRect(hwnd As LongPtr, hItem As LongPtr, prc As RECT, Code As Long) As Long
TreeView_GetItemRect = CLng(SendMessage(hwnd, TVM_GETITEMRECT, Code, prc))
End Function

Private Function TreeView_GetLineColor(hwnd As LongPtr) As Long
    TreeView_GetLineColor = CLng(SendMessage(hwnd, TVM_GETLINECOLOR, 0, ByVal 0&))
End Function

Private Function TreeView_SetLineColor(hwnd As LongPtr, clr As Long) As Long
    TreeView_SetLineColor = CLng(SendMessage(hwnd, TVM_SETLINECOLOR, 0, ByVal clr))
End Function

Private Function TreeView_SetStyle(hwnd As LongPtr, dwStyle As ucst_TV_Styles) As Long
    Dim lStyle As LongPtr
    lStyle = GetWindowLong(hwnd, GWL_STYLE)
    lStyle = lStyle Or dwStyle
    TreeView_SetStyle = CLng(SetWindowLong(hwnd, GWL_STYLE, lStyle))

End Function

Private Function TreeView_SetExtendedStyle(hwnd As LongPtr, lST As ucst_TV_Ex_Styles) As Long
    Dim lStyle As LongPtr

    lStyle = SendMessage(hwnd, TVM_GETEXTENDEDSTYLE, 0, 0)
    lStyle = lStyle Or lST
    Call SendMessage(hwnd, TVM_SETEXTENDEDSTYLE, 0, ByVal lStyle)

End Function

' TreeView_GetNextItem

' Retrieves the tree-view item that bears the specified relationship to a specified item.
' Returns the handle to the item if successful or 0 otherwise.

Private Function TreeView_GetNextItem(hwnd As LongPtr, _
                                     hItem As LongPtr, _
                                     flag As ucst_TVM_GETNEXTITEM_wParam) As LongPtr
    TreeView_GetNextItem = SendMessage(hwnd, TVM_GETNEXTITEM, ByVal flag, ByVal hItem)
End Function

Private Function TreeView_GetNextSelected(hwnd As LongPtr, hItem As LongPtr) As LongPtr
    TreeView_GetNextSelected = TreeView_GetNextItem(hwnd, hItem, TVGN_NEXTSELECTED)
End Function
' Retrieves the first child item. The hitem parameter must be NULL.
' Returns the handle to the item if successful or 0 otherwise.

Private Function TreeView_GetChild(hwnd As LongPtr, hItem As LongPtr) As LongPtr
    TreeView_GetChild = TreeView_GetNextItem(hwnd, hItem, TVGN_CHILD)
End Function

' Retrieves the next sibling item.
' Returns the handle to the item if successful or 0 otherwise.

Private Function TreeView_GetNextSibling(hwnd As LongPtr, hItem As LongPtr) As LongPtr
    TreeView_GetNextSibling = TreeView_GetNextItem(hwnd, hItem, TVGN_NEXT)
End Function

Private Function TreeView_GetPrevSibling(hwnd As LongPtr, hItem As LongPtr) As LongPtr
  TreeView_GetPrevSibling = TreeView_GetNextItem(hwnd, hItem, TVGN_PREVIOUS)
End Function

Private Function TreeView_GetNextVisible(hwnd As LongPtr, hItem As LongPtr) As LongPtr
  TreeView_GetNextVisible = TreeView_GetNextItem(hwnd, hItem, TVGN_NEXTVISIBLE)
End Function

Private Function TreeView_GetPrevVisible(hwnd As LongPtr, hItem As LongPtr) As LongPtr
  TreeView_GetPrevVisible = TreeView_GetNextItem(hwnd, hItem, TVGN_PREVIOUSVISIBLE)
End Function

' Retrieves the parent of the specified item.
' Returns the handle to the item if successful or 0 otherwise.
Private Function TreeView_SelectDropTarget(hwnd As LongPtr, hItem As LongPtr) As Long
  TreeView_SelectDropTarget = TreeView_Select(hwnd, hItem, TVGN_DROPHILITE)
End Function

Private Function TreeView_SelectSetFirstVisible(hwnd As LongPtr, hItem As LongPtr) As Long
  TreeView_SelectSetFirstVisible = TreeView_Select(hwnd, hItem, TVGN_FIRSTVISIBLE)
End Function

Private Function TreeView_SetAutoScrollInfo(hwnd As LongPtr, uPixPerSec As Long, uUpdateTime As Long) As Long
TreeView_SetAutoScrollInfo = CLng(SendMessage(hwnd, TVM_SETAUTOSCROLLINFO, uPixPerSec, ByVal uUpdateTime))
End Function

'#define TreeView_SetBorder(hwnd, dwFlags, xBorder, yBorder) (int)SNDMSG ((hwnd), TVM_SETBORDER,(WPARAM) (dwFlags),
'MAKELPARAM (xBorder, yBorder))
Private Function TreeView_SetBorder(hwnd As LongPtr, dwFlags As ucst_TVSB_Flags, xBorder As Long, yBorder As Long) As Long
TreeView_SetBorder = CLng(SendMessage(hwnd, TVM_SETBORDER, dwFlags, ByVal MAKELPARAM(xBorder, yBorder)))
End Function

Private Function TreeView_SetHot(hwnd As LongPtr, hItem As LongPtr) As Long
TreeView_SetHot = CLng(SendMessage(hwnd, TVM_SETHOT, 0, ByVal hItem))
End Function

Private Function TreeView_SetTextColor(hwnd As LongPtr, clr As Long) As Long
TreeView_SetTextColor = CLng(SendMessage(hwnd, TVM_SETTEXTCOLOR, 0, ByVal clr))
End Function

Private Function TreeView_ShowInfoTip(hwnd As LongPtr, hItem As LongPtr) As Long
TreeView_ShowInfoTip = CLng(SendMessage(hwnd, TVM_SHOWINFOTIP, 0, ByVal hItem))
End Function

Private Function TreeView_GetParent(hwnd As LongPtr, hItem As LongPtr) As LongPtr
    TreeView_GetParent = TreeView_GetNextItem(hwnd, hItem, TVGN_PARENT)
End Function

Private Function TreeView_MapAccIDToHTREEITEM(hwnd As LongPtr, id As Long) As LongPtr
TreeView_MapAccIDToHTREEITEM = SendMessage(hwnd, TVM_MAPACCIDTOHTREEITEM, id, ByVal 0)
End Function

Private Function TreeView_MapHTREEITEMToAccID(hwnd As LongPtr, htreeitem As LongPtr) As Long
TreeView_MapHTREEITEMToAccID = CLng(SendMessage(hwnd, TVM_MAPHTREEITEMTOACCID, htreeitem, ByVal 0))
End Function

' Retrieves the currently selected item.
' Returns the handle to the item if successful or 0 otherwise.

Private Function TreeView_GetSelection(hwnd As LongPtr) As LongPtr
    TreeView_GetSelection = TreeView_GetNextItem(hwnd, 0, TVGN_CARET)
End Function

Private Function TreeView_InsertItem(hwnd As LongPtr, lpis As TVINSERTSTRUCT) As LongPtr
TreeView_InsertItem = SendMessage(hwnd, TVM_INSERTITEM, 0, lpis)
End Function

Private Function TreeView_InsertItemEx(hwnd As LongPtr, lpis As TVINSERTSTRUCTEX) As LongPtr
TreeView_InsertItemEx = SendMessage(hwnd, TVM_INSERTITEM, 0, lpis)
End Function
' Retrieves the topmost or very first item of the tree-view control.
' Returns the handle to the item if successful or 0 otherwise.

Private Function TreeView_GetRoot(hwnd As LongPtr) As LongPtr
    TreeView_GetRoot = TreeView_GetNextItem(hwnd, 0, TVGN_ROOT)
End Function

' Retrieves some or all of a tree-view item's attributes.
' Returns TRUE if successful or FALSE otherwise.

Private Function TreeView_GetItem(hwnd As LongPtr, pItem As TVITEM) As Boolean
    TreeView_GetItem = SendMessage(hwnd, TVM_GETITEM, 0, pItem)
End Function

Private Function TreeView_GetItemState(hwndTV As LongPtr, hti As LongPtr, Mask As ucst_TVITEM_State) As Long
    TreeView_GetItemState = CLng(SendMessage(hwndTV, TVM_GETITEMSTATE, hti, ByVal Mask))
End Function
' Sets some or all of a tree-view item's attributes.
' Old docs say returns zero if successful or - 1 otherwise.
' New docs say returns TRUE if successful, or FALSE otherwise

Private Function TreeView_SetItem(hwnd As LongPtr, pItem As TVITEM) As Boolean
    TreeView_SetItem = SendMessage(hwnd, TVM_SETITEM, 0, pItem)
End Function

Private Function TreeView_SetItemState(hwndTV As LongPtr, _
                                      hti As LongPtr, _
                                      data As ucst_TVITEM_State, _
                                      Mask As ucst_TVITEM_State) As Long
    Dim tVI As TVITEMEX
    tVI.Mask = TVIF_STATE Or TVIF_HANDLE
    tVI.hItem = hti
    tVI.StateMask = Mask
    tVI.State = data
    TreeView_SetItemState = CLng(SendMessage(hwndTV, TVM_SETITEM, 0, tVI))
End Function

Private Function TreeView_SetItemStateEx(hwndTV As LongPtr, _
                                        hti As LongPtr, _
                                        Mask As ucst_TVITEM_State_Ex) As Long
    Dim tVI As TVITEMEX
    tVI.Mask = TVIF_STATEEX
    tVI.hItem = hti
    tVI.uStateEx = Mask
    TreeView_SetItemStateEx = CLng(SendMessage(hwndTV, TVM_SETITEM, 0, tVI))
End Function

Private Function TreeView_SetCheckState(hwndTV As LongPtr, _
                                       hti As LongPtr, _
                                       fCheck As Long) As Long
    TreeView_SetCheckState = TreeView_SetItemState(hwndTV, hti, IndexToStateImageMask(IIf(fCheck, 2, 1)), TVIS_STATEIMAGEMASK)

End Function

Private Function TreeView_SetCheckStateEx(hwndTV As LongPtr, _
                                       hti As LongPtr, _
                                       fCheck As Long) As Long
    TreeView_SetCheckStateEx = TreeView_SetItemState(hwndTV, hti, IndexToStateImageMask(fCheck), TVIS_STATEIMAGEMASK)

End Function

Private Function TreeView_GetCheckState(hwndTV As LongPtr, hti As LongPtr) As Long
    TreeView_GetCheckState = StateImageMaskToIndex(CLng(SendMessage(hwndTV, TVM_GETITEMSTATE, hti, ByVal TVIS_STATEIMAGEMASK)))

End Function
' Determines the location of the specified point relative to the client area of a tree-view control.
' Returns the handle to the tree-view item that occupies the specified point or NULL if no item
' occupies the point.

Private Function TreeView_HitTest(hwnd As LongPtr, lpht As TVHITTESTINFO) As LongPtr
    TreeView_HitTest = SendMessage(hwnd, TVM_HITTEST, 0, lpht)
End Function
' Removes an item from a tree-view control.
' Returns TRUE if successful or FALSE otherwise.

Private Function TreeView_DeleteItem(hwnd As LongPtr, hItem As LongPtr) As Boolean
    TreeView_DeleteItem = SendMessage(hwnd, TVM_DELETEITEM, 0, ByVal hItem)
End Function

' Removes all items from a tree-view control.
' Returns TRUE if successful or FALSE otherwise.

Private Function TreeView_DeleteAllItems(hwnd As LongPtr) As Boolean
    TreeView_DeleteAllItems = SendMessage(hwnd, TVM_DELETEITEM, 0, ByVal TVI_ROOT)
End Function
' Creates a dragging bitmap for the specified item in a tree-view control, creates an image list
' for the bitmap, and adds the bitmap to the image list. An application can display the image
' when dragging the item by using the image list functions.
' Returns the handle of the image list to which the dragging bitmap was added if successful or
' NULL otherwise.

Private Function TreeView_CreateDragImage(hwnd As LongPtr, hItem As LongPtr) As LongPtr
    TreeView_CreateDragImage = SendMessage(hwnd, TVM_CREATEDRAGIMAGE, 0, ByVal hItem)
End Function

' Sorts the child items of the specified parent item in a tree-view control.
' Returns TRUE if successful or FALSE otherwise.
' fRecurse is reserved for future use and must be zero.
Private Function TreeView_EditLabel(hwnd As LongPtr, hItem As LongPtr) As LongPtr
    TreeView_EditLabel = SendMessage(hwnd, TVM_EDITLABEL, ByVal 0&, ByVal hItem)
End Function

Private Function TreeView_EndEditLabelNow(hwnd As LongPtr, fCancel As Long) As Long
    TreeView_EndEditLabelNow = CLng(SendMessage(hwnd, TVM_ENDEDITLABELNOW, fCancel, ByVal 0))
End Function

Private Function TreeView_GetFirstVisible(hwnd As LongPtr) As LongPtr
    TreeView_GetFirstVisible = TreeView_GetNextItem(hwnd, 0, TVGN_FIRSTVISIBLE)
End Function

Private Function TreeView_GetLastVisible(hwnd As LongPtr) As LongPtr   ' IE4
    TreeView_GetLastVisible = TreeView_GetNextItem(hwnd, 0, TVGN_LASTVISIBLE)
End Function

Private Function TreeView_GetBkColor(hwnd As LongPtr) As Long
    TreeView_GetBkColor = CLng(SendMessage(hwnd, TVM_GETBKCOLOR, 0, ByVal 0))
End Function

Private Function TreeView_SetInsertMark(hwnd As LongPtr, _
                                       hItem As LongPtr, _
                                       fAfter As Long) As Boolean   ' IE4
    TreeView_SetInsertMark = SendMessage(hwnd, TVM_SETINSERTMARK, ByVal fAfter, ByVal hItem)
End Function

Private Function TreeView_GetCount(hwnd As LongPtr) As Long
    TreeView_GetCount = CLng(SendMessage(hwnd, TVM_GETCOUNT, 0, ByVal 0&))
End Function

Private Function TreeView_GetDropHilight(hwnd As LongPtr) As LongPtr
    TreeView_GetDropHilight = TreeView_GetNextItem(hwnd, 0, TVGN_DROPHILITE)
End Function

Private Function TreeView_GetExtendedStyle(hwnd As LongPtr) As Long
    TreeView_GetExtendedStyle = CLng(SendMessage(hwnd, TVM_GETEXTENDEDSTYLE, 0, ByVal 0))
End Function

Private Function TreeView_SetUnicodeFormat(hwnd As LongPtr, _
                                          fUnicode As Long) As Boolean   ' IE4
    TreeView_SetUnicodeFormat = SendMessage(hwnd, TVM_SETUNICODEFORMAT, ByVal fUnicode, 0)
End Function

Private Function TreeView_GetUnicodeFormat(hwnd As LongPtr) As Boolean   ' IE4
    TreeView_GetUnicodeFormat = SendMessage(hwnd, TVM_GETUNICODEFORMAT, 0, 0)
End Function

' returns (int), old?
Private Function TreeView_SetItemHeight(hwnd As LongPtr, iHeight As Long) As Long   ' IE4
    TreeView_SetItemHeight = CLng(SendMessage(hwnd, TVM_SETITEMHEIGHT, ByVal iHeight, 0))
End Function

Private Function TreeView_GetTextColor(hwnd As LongPtr) As Long   ' IE4
    TreeView_GetTextColor = CLng(SendMessage(hwnd, TVM_GETTEXTCOLOR, 0, 0))
End Function

' returns (UINT), old?
Private Function TreeView_SetScrollTime(hwnd As LongPtr, uTime As Long) As Long   ' IE4
    TreeView_SetScrollTime = CLng(SendMessage(hwnd, TVM_SETSCROLLTIME, ByVal uTime, 0))
End Function

' returns (UINT)
Private Function TreeView_GetScrollTime(hwnd As LongPtr) As Long   ' IE4
    TreeView_GetScrollTime = CLng(SendMessage(hwnd, TVM_GETSCROLLTIME, 0, 0))
End Function

' returns (COLORREF), old?
Private Function TreeView_SetInsertMarkColor(hwnd As LongPtr, clr As Long) As Long   ' IE4
    TreeView_SetInsertMarkColor = CLng(SendMessage(hwnd, TVM_SETINSERTMARKCOLOR, 0, ByVal clr))
End Function

' returns (COLORREF)
Private Function TreeView_GetInsertMarkColor(hwnd As LongPtr) As Long   ' IE4
    TreeView_GetInsertMarkColor = CLng(SendMessage(hwnd, TVM_GETINSERTMARKCOLOR, 0, 0))
End Function
'
' ================================================================

' returns (int)
Private Function TreeView_GetItemHeight(hwnd As LongPtr) As Long   ' IE4
    TreeView_GetItemHeight = CLng(SendMessage(hwnd, TVM_GETITEMHEIGHT, 0, 0))
End Function

' returns (COLORREF), old?
Private Function TreeView_SetBkColor(hwnd As LongPtr, clr As Long) As Long   ' IE4
    TreeView_SetBkColor = CLng(SendMessage(hwnd, TVM_SETBKCOLOR, 0, ByVal clr))
End Function

' Retrieves the handle to the edit control being used to edit a tree-view item's text.
' Returns the handle to the edit control if successful or NULL otherwise.

Private Function TreeView_GetEditControl(hwnd As LongPtr) As LongPtr
    TreeView_GetEditControl = SendMessage(hwnd, TVM_GETEDITCONTROL, 0, 0)
End Function

' Returns the number of items that are fully visible in the client window of the tree-view control.

Private Function TreeView_GetVisibleCount(hwnd As LongPtr) As Long
    TreeView_GetVisibleCount = CLng(SendMessage(hwnd, TVM_GETVISIBLECOUNT, 0, 0))
End Function

Private Function TreeView_SortChildren(hwnd As LongPtr, _
                                      hItem As LongPtr, _
                                      fRecurse As Boolean) As Boolean
    TreeView_SortChildren = SendMessage(hwnd, TVM_SORTCHILDREN, ByVal fRecurse, ByVal hItem)
End Function

' Ensures that a tree-view item is visible, expanding the parent item or scrolling the tree-view
' control, if necessary.
' Returns TRUE if the system scrolled the items in the tree-view control to ensure that the
' specified item is visible. Otherwise, the macro returns FALSE.

Private Function TreeView_EnsureVisible(hwnd As LongPtr, hItem As LongPtr) As Boolean
    TreeView_EnsureVisible = SendMessage(hwnd, TVM_ENSUREVISIBLE, 0, ByVal hItem)
End Function
' Expands or collapses the list of child items, if any, associated with the specified parent item.
' Returns TRUE if successful or FALSE otherwise.
' (docs say TVM_EXPAND does not send the TVN_ITEMEXPANDING and
' TVN_ITEMEXPANDED notification messages to the parent window...?)

Private Function TreeView_Expand(hwnd As LongPtr, hItem As LongPtr, flag As ucst_TVM_EXPAND_wParam) As Boolean
    TreeView_Expand = SendMessage(hwnd, TVM_EXPAND, ByVal flag, ByVal hItem)
End Function

' Selects the specified tree-view item, scrolls the item into view, or redraws the item
' in the style used to indicate the target of a drag-and-drop operation.
' If hitem is NULL, the selection is removed from the currently selected item, if any.
' Returns TRUE if successful or FALSE otherwise.

Private Function TreeView_Select(hwnd As LongPtr, hItem As LongPtr, Code As Long) As Boolean
    TreeView_Select = SendMessage(hwnd, TVM_SELECTITEM, ByVal Code, ByVal hItem)
End Function

' Sets the selection to the specified item.
' Returns TRUE if successful or FALSE otherwise.

' If the specified item is already selected, a TVN_SELCHANGING *will not* be generated !!

' If the specified item is 0 (indicating to remove selection from any currrently selected item)
' and an item is selected, a TVN_SELCHANGING *will* be generated and the itemNew
' member of NMTREEVIEW will be 0 !!!

Private Function TreeView_SelectItem(hwnd As LongPtr, hItem As LongPtr) As Boolean
    TreeView_SelectItem = TreeView_Select(hwnd, hItem, TVGN_CARET)
End Function

' Sorts tree-view items using an application-defined callback function that compares the items.
' Returns TRUE if successful or FALSE otherwise.
' fRecurse is reserved for future use and must be zero.

Private Function TreeView_SortChildrenCB(hwnd As LongPtr, _
                                        psort As TVSORTCB, _
                                        fRecurse As Boolean) As Boolean
    TreeView_SortChildrenCB = SendMessage(hwnd, TVM_SORTCHILDRENCB, ByVal fRecurse, psort)
End Function

Private Function MAKELPARAM(wLow As Long, wHigh As Long) As Long
  MAKELPARAM = MakeLong(wLow, wHigh)
End Function

Private Function MakeLong(wLow As Long, wHigh As Long) As Long
  MakeLong = LoWord(wLow) Or (&H10000 * LoWord(wHigh))
End Function

' Returns the lParam of the specified treeview item.
Private Function GetTVItemlParam(hwndTV As LongPtr, hItem As LongPtr) As LongPtr
  Dim tVI As TVITEM
  
  tVI.hItem = hItem
  tVI.Mask = TVIF_PARAM
  
  If TreeView_GetItem(hwndTV, tVI) Then
    GetTVItemlParam = tVI.lParam
  End If

End Function

Private Sub DEFINE_UUID(Name As UUID, l As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
  With Name
    .Data1 = l
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
End Sub
Private Sub DEFINE_OLEGUID(Name As UUID, l As Long, w1 As Integer, w2 As Integer)
  DEFINE_UUID Name, l, w1, w2, &HC0, 0, 0, 0, 0, 0, 0, &H46
End Sub

Private Function IID_IShellItem() As UUID
Static IID As UUID
If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H43826D1E, CInt(&HE718), CInt(&H42EE), &HBC, &H55, &HA1, &HE2, &H61, &HC3, &H7B, &HFE)
IID_IShellItem = IID
End Function
Private Function IID_IShellItem2() As UUID
'7e9fb0d3-919f-4307-ab2e-9b1860310c93
Static IID As UUID
If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H7E9FB0D3, CInt(&H919F), CInt(&H4307), &HAB, &H2E, &H9B, &H18, &H60, &H31, &HC, &H93)
IID_IShellItem2 = IID
End Function
Private Function IID_IEnumShellItems() As UUID
'{70629033-e363-4a28-a567-0db78006e6d7}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H70629033, CInt(&HE363), CInt(&H4A28), &HA5, &H67, &HD, &HB7, &H80, &H6, &HE6, &HD7)
 IID_IEnumShellItems = IID
End Function
Private Function IID_IShellLinkW() As UUID
'{000214F9-0000-0000-C000-000000000046}
Static IID As UUID
 If (IID.Data1 = 0&) Then Call DEFINE_UUID(IID, &H214F9, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
IID_IShellLinkW = IID
End Function
Private Function IID_IParentAndItem() As UUID
'{b3a4b685-b685-4805-99d9-5dead2873236}
Static IID As UUID
 If (IID.Data1 = 0&) Then Call DEFINE_UUID(IID, &HB3A4B685, CInt(&HB685), CInt(&H4805), &H99, &HD9, &H5D, &HEA, &HD2, &H87, &H32, &H36)
IID_IParentAndItem = IID
End Function
Private Function IID_IShellIcon() As UUID
'{000214E5-0000-0000-C000-000000000046}
Static IID As UUID
 If (IID.Data1 = 0&) Then Call DEFINE_UUID(IID, &H214E5, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
IID_IShellIcon = IID
End Function
Private Function IID_IPersistIDList() As UUID
'{1079acfc-29bd-11d3-8e0d-00c04f6837d5}
Static IID As UUID
 If (IID.Data1 = 0&) Then Call DEFINE_UUID(IID, &H1079ACFC, CInt(&H29BD), CInt(&H11D3), &H8E, &HD, &H0, &HC0, &H4F, &H68, &H37, &HD5)
IID_IPersistIDList = IID
End Function
Private Function IID_IImageList() As UUID
'{46EB5926-582E-4017-9FDF-E8998DAA0950}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H46EB5926, CInt(&H582E), CInt(&H4017), &H9F, &HDF, &HE8, &H99, &H8D, &HAA, &H9, &H50)
 IID_IImageList = IID
End Function
Private Function IID_IContextMenu() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_OLEGUID(IID, &H214E4, 0, 0)
 IID_IContextMenu = IID
End Function
Private Function IID_IContextMenu2() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_OLEGUID(IID, &H214F4, 0, 0)
 IID_IContextMenu2 = IID
End Function
Private Function IID_IContextMenu3() As UUID
'{BCFCE0A0-EC17-11d0-8D10-00A0C90F2719}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HBCFCE0A0, CInt(&HEC17), CInt(&H11D0), &H8D, &H10, &H0, &HA0, &HC9, &HF, &H27, &H19)
 IID_IContextMenu3 = IID
End Function
Private Function IID_IDataObject() As UUID
'0000010e-0000-0000-C000-000000000046
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H10E, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
  IID_IDataObject = IID
End Function
Private Function IID_IDropTarget() As UUID
'{00000122-0000-0000-C000-000000000046}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H122, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
 IID_IDropTarget = IID
End Function
Private Function IID_IShellItemArray() As UUID
'{b63ea76d-1f85-456f-a19c-48159efa858b}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HB63EA76D, CInt(&H1F85), CInt(&H456F), &HA1, &H9C, &H48, &H15, &H9E, &HFA, &H85, &H8B)
  IID_IShellItemArray = IID
End Function
Private Function IID_IPropertyDescriptionList() As UUID
'IID_IPropertyDescriptionList, 0x1f9fc1d0, 0xc39b, 0x4b26, 0x81,0x7f, 0x01,0x19,0x67,0xd3,0x44,0x0e
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H1F9FC1D0, CInt(&HC39B), CInt(&H4B26), &H81, &H7F, &H1, &H19, &H67, &HD3, &H44, &HE)
  IID_IPropertyDescriptionList = IID
End Function
Private Function IID_IPropertyStore() As UUID
'DEFINE_GUID(IID_IPropertyStore,0x886d8eeb, 0x8cf2, 0x4446, 0x8d,0x02,0xcd,0xba,0x1d,0xbd,0xcf,0x99);
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H886D8EEB, CInt(&H8CF2), CInt(&H4446), &H8D, &H2, &HCD, &HBA, &H1D, &HBD, &HCF, &H99)
  IID_IPropertyStore = IID
End Function
Private Function IID_IPropertyDescription() As UUID
'(IID_IPropertyDescription, 0x6f79d558, 0x3e96, 0x4549, 0xa1,0xd1, 0x7d,0x75,0xd2,0x28,0x88,0x14
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H6F79D558, CInt(&H3E96), CInt(&H4549), &HA1, &HD1, &H7D, &H75, &HD2, &H28, &H88, &H14)
  IID_IPropertyDescription = IID
End Function
Private Function IID_IQueryInfo() As UUID
'{00021500-0000-0000-C000-000000000046}
Static IID As UUID
 If (IID.Data1 = 0&) Then Call DEFINE_UUID(IID, &H21500, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
IID_IQueryInfo = IID
End Function

Private Function BHID_EnumItems() As UUID
'{0x94F60519, 0x2850, 0x4924, 0xAA,0x5A, 0xD1,0x5E,0x84,0x86,0x80,0x39}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H94F60519, &H2850, &H4924, &HAA, &H5A, &HD1, &H5E, &H84, &H86, &H80, &H39)
 BHID_EnumItems = IID
End Function
Private Function BHID_DataObject() As UUID
'{0xB8C0BD9F, 0xED24, 0x455C, 0x83,0xE6, 0xD5,0x39,0x0C,0x4F,0xE8,0xC4}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HB8C0BD9F, &HED24, &H455C, &H83, &HE6, &HD5, &H39, &HC, &H4F, &HE8, &HC4)
 BHID_DataObject = IID
End Function
Private Function BHID_SFUIObject() As UUID
'DEFINE_GUID(BHID_SFUIObject,  0x3981E225, 0xF559, 0x11D3, 0x8E,0x3A, 0x00,0xC0,0x4F,0x68,0x37,0xD5);
'{3981e225-f559-11d3-8e3a-00c04f6837d5}
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H3981E225, &HF559, &H11D3, &H8E, &H3A, &H0, &HC0, &H4F, &H68, &H37, &HD5)
  BHID_SFUIObject = IID
End Function

Private Function FOLDERID_ComputerFolder() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HAC0837C, CInt(&HBBF8), CInt(&H452A), &H85, &HD, &H79, &HD0, &H8E, &H66, &H7C, &HA7)
 FOLDERID_ComputerFolder = IID
End Function
Private Function FOLDERID_Windows() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HF38BF404, CInt(&H1D43), CInt(&H42F2), &H93, &H5, &H67, &HDE, &HB, &H28, &HFC, &H23)
 FOLDERID_Windows = IID
End Function
Private Function FOLDERID_Favorites() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H1777F761, CInt(&H68AD), CInt(&H4D8A), &H87, &HBD, &H30, &HB7, &H59, &HFA, &H33, &HDD)
 FOLDERID_Favorites = IID
End Function
Private Function FOLDERID_Links() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HBFB9D5E0, CInt(&HC6A9), CInt(&H404C), &HB2, &HB2, &HAE, &H6D, &HB6, &HAF, &H49, &H68)
 FOLDERID_Links = IID
End Function
Private Function FOLDERID_Libraries() As UUID
'{1B3EA5DC-B587-4786-B4EF-BD1DC332AEAE}
Static IID As UUID
 If (IID.Data1 = 0&) Then Call DEFINE_UUID(IID, &H1B3EA5DC, CInt(&HB587), CInt(&H4786), &HB4, &HEF, &HBD, &H1D, &HC3, &H32, &HAE, &HAE)
FOLDERID_Libraries = IID
End Function
Private Function FOLDERID_Desktop() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &HB4BFCC3A, CInt(&HDB2C), CInt(&H424C), &HB0, &H29, &H7F, &HE9, &H9A, &H87, &HC6, &H41)
 FOLDERID_Desktop = IID
End Function
Private Function FOLDERID_UserProfiles() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H762D272, CInt(&HC50A), CInt(&H4BB0), &HA3, &H82, &H69, &H7D, &HCD, &H72, &H9B, &H80)
 FOLDERID_UserProfiles = IID
End Function
Private Function FOLDERID_Profile() As UUID
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H5E6C858F, CInt(&HE22), CInt(&H4760), &H9A, &HFE, &HEA, &H33, &H17, &HB6, &H71, &H73)
 FOLDERID_Profile = IID
End Function

Private Sub DEFINE_PROPERTYKEY(Name As PROPERTYKEY, l As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte, pid As Long)
  With Name.fmtid
    .Data1 = l
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
  Name.pid = pid
End Sub

Private Function PKEY_PropList_InfoTip() As PROPERTYKEY
Static pkk As PROPERTYKEY
 If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &HC9944A21, &HA406, &H48FE, &H82, &H25, &HAE, &HC7, &HE2, &H4C, &H21, &H1B, 4)
PKEY_PropList_InfoTip = pkk
End Function
Private Function PKEY_SFGAOFlags() As PROPERTYKEY
Static pkk As PROPERTYKEY
 If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &H28636AA6, &H953D, &H11D2, &HB5, &HD6, &H0, &HC0, &H4F, &HD9, &H18, &HD0, 25)
PKEY_SFGAOFlags = pkk
End Function



    Private Sub UserControl_ReadProperties(PropBag As PropertyBag) Handles UserControl.ReadProperties
        DebugAppend "UserControl_ReadProperties"
        clrBack = PropBag.ReadProperty("BackColor", vbWindowBackground)
        clrFore = PropBag.ReadProperty("ForeColor", vbWindowText)
        mBorder = PropBag.ReadProperty("BorderStyle", mBorder_def)
        Set PropFont = PropBag.ReadProperty("Font", Nothing)
        mCheckboxes = PropBag.ReadProperty("Checkboxes", mCheckboxes_def)
        mExCheckboxes = PropBag.ReadProperty("ExclusionChecks", mExCheckboxes_def)
        mAutoHS = PropBag.ReadProperty("AutoHScroll", mDefAutoHS)
        mShowSelAlw = PropBag.ReadProperty("ShowSelAlways", mDefShowSelAlw)
        mExplorerStyle = PropBag.ReadProperty("ExplorerStyle", mExplorerStyle_def)
        mShowFiles = PropBag.ReadProperty("ShowFiles", mShowFiles_def)
        m_TrackSel = PropBag.ReadProperty("TrackSelect", m_def_TrackSel)
        mFadeExpandos = PropBag.ReadProperty("FadingExpandos", mFadeExpandos_def)
        mShowLines = PropBag.ReadProperty("ShowLines", mShowLines_def)
        mHasButtons = PropBag.ReadProperty("HasButtons", mHasButtons_def)
        mSingleExpand = PropBag.ReadProperty("SingleExpand", mSingleExpand_def)
        mComputerAsRoot = PropBag.ReadProperty("ComputerAsRoot", mComputerAsRoot_def)
        mFullRowSelect = PropBag.ReadProperty("FullRowSelect", mFullRowSelect_def)
        mExpandZip = PropBag.ReadProperty("ExpandZip", mExpandZip_def)
        mFilter = PropBag.ReadProperty("ItemFilter", mFilter_def)
        mFilterFilesOnly = PropBag.ReadProperty("ItemFilterFilesOnly", mFilterFilesOnly_def)
        mInfoTipOnFolders = PropBag.ReadProperty("InfoTipOnFolders", mInfoTipOnFolders_def)
        mInfoTipOnFiles = PropBag.ReadProperty("InfoTipOnFiles", mInfoTipOnFiles_def)
        mExpandOnLabelClick = PropBag.ReadProperty("SingleClickExpand", mExpandOnLabelClick_def)
        mNavSound = PropBag.ReadProperty("PlayNavigationSound", mNavSound_def)
        mFavorites = PropBag.ReadProperty("ShowFavorites", mFavorites_def)
        mSHCN = PropBag.ReadProperty("MonitorDirChanges", mSHCN_def)
        lRaiseHover = PropBag.ReadProperty("ActiveDropHoverTime", m_def_lRaiseHover)
        mLabelEdit = PropBag.ReadProperty("LabelEditRename", mLabelEdit_def)
        mNameColors = PropBag.ReadProperty("NameColors", mNameColors_def)
        mInitialPath = PropBag.ReadProperty("InitialPath", mInitialPath_def)
        mCustomRoot = PropBag.ReadProperty("CustomRoot", mCustomRoot_def)
        mRootHasCheckbox = PropBag.ReadProperty("RootHasCheckbox", mRootHasCheckbox_def)
        mHScroll = PropBag.ReadProperty("HorizontalScroll", mHScroll_def)
        mAutocheck = PropBag.ReadProperty("Autocheck", mAutocheck_def)
        mExtOverlay = PropBag.ReadProperty("ExtendedOverlays", m_def_ExtOverlay)
        mMultiSel = PropBag.ReadProperty("Multiselect", mDefMultiSel)
        mDisableDD = PropBag.ReadProperty("DisableDragDrop", mDefDisableDD)
        mAlwaysShowExtVerbs = PropBag.ReadProperty("AlwaysShowExtendedVerbs", mDefAlwaysShowExtVerbs)
        mNoIndState = PropBag.ReadProperty("NoIndentState", mDefNoIndState)
        mIndent = PropBag.ReadProperty("Indentation", mDefIndent)
        m_HiddenPref = PropBag.ReadProperty("ShowHiddenItems", m_def_HiddenPref)
        m_SuperHiddenPref = PropBag.ReadProperty("ShowSuperHidden", m_def_SuperHiddenPref)
        m_EnableShellMenu = PropBag.ReadProperty("EnableShellMenu", m_def_EnableShellMenu)
        m_Win10QA = PropBag.ReadProperty("ShowQuickAccessOnWin10", m_def_Win10QA)
        mExpComp = PropBag.ReadProperty("AutoExpandComputer", mDefExpComp)
        mExpLib = PropBag.ReadProperty("AutoExpandLibraries", mDefExpLib)
        m_NoWow64 = PropBag.ReadProperty("DisableWow64Redirect", m_def_NoWow64)
        mIconSize = PropBag.ReadProperty("IconSize", mDefIconSize)
        m_ForceExt = PropBag.ReadProperty("FileExtensions", m_def_ForceExt)
        mShowOnlyFileCheckbox = PropBag.ReadProperty("ShowOnlyFileCheckboxes", mDefShowOnlyFileCheckbox)
        pvCreate
    End Sub
    
    Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Handles UserControl.WriteProperties
        DebugAppend "UserControl_WriteProperties"
        PropBag.WriteProperty "BackColor", clrBack, vbWindowBackground
        PropBag.WriteProperty "ForeColor", clrFore, vbWindowText
        PropBag.WriteProperty "Font", IIf(OLEFontIsEqual(PropFont, Ambient.Font) = False, PropFont, Nothing), Nothing
        'DebugAppend "WriteProps passed font"
        PropBag.WriteProperty "Checkboxes", mCheckboxes, mCheckboxes_def
        PropBag.WriteProperty "ExclusionChecks", mExCheckboxes, mExCheckboxes_def
        PropBag.WriteProperty "ShowSelAlways", mShowSelAlw, mDefShowSelAlw
        PropBag.WriteProperty "ExplorerStyle", mExplorerStyle, mExplorerStyle_def
        PropBag.WriteProperty "ShowFiles", mShowFiles, mShowFiles_def
        PropBag.WriteProperty "FadingExpandos", mFadeExpandos, mFadeExpandos_def
        PropBag.WriteProperty "ShowLines", mShowLines, mShowLines_def
        PropBag.WriteProperty "HasButtons", mHasButtons, mHasButtons_def
        PropBag.WriteProperty "TrackSelect", m_TrackSel, m_def_TrackSel
        PropBag.WriteProperty "SingleExpand", mSingleExpand, mSingleExpand_def
        PropBag.WriteProperty "ComputerAsRoot", mComputerAsRoot, mComputerAsRoot_def
        PropBag.WriteProperty "FullRowSelect", mFullRowSelect, mFullRowSelect_def
        PropBag.WriteProperty "ExpandZip", mExpandZip, mExpandZip_def
        PropBag.WriteProperty "ItemFilter", mFilter, mFilter_def
        PropBag.WriteProperty "ItemFilterFilesOnly", mFilterFilesOnly, mFilterFilesOnly_def
        PropBag.WriteProperty "InfoTipOnFolders", mInfoTipOnFolders, mInfoTipOnFolders_def
        PropBag.WriteProperty "InfoTipOnFiles", mInfoTipOnFiles, mInfoTipOnFiles_def
        PropBag.WriteProperty "SingleClickExpand", mExpandOnLabelClick, mExpandOnLabelClick_def
        PropBag.WriteProperty "PlayNavigationSound", mNavSound, mNavSound_def
        PropBag.WriteProperty "ShowFavorites", mFavorites, mFavorites_def
        PropBag.WriteProperty "MonitorDirChanges", mSHCN, mSHCN_def
        PropBag.WriteProperty "ActiveDropHoverTime", lRaiseHover, m_def_lRaiseHover
        PropBag.WriteProperty "LabelEditRename", mLabelEdit, mLabelEdit_def
        PropBag.WriteProperty "NameColors", mNameColors, mNameColors_def
        'PropBag.WriteProperty "Border", mBorder, mBorder_def
        PropBag.WriteProperty "BorderStyle", mBorder, mBorder_def
        PropBag.WriteProperty "InitialPath", mInitialPath, mInitialPath_def
        PropBag.WriteProperty "CustomRoot", mCustomRoot, mCustomRoot_def
        PropBag.WriteProperty "RootHasCheckbox", mRootHasCheckbox, mRootHasCheckbox_def
        PropBag.WriteProperty "HorizontalScroll", mHScroll, mHScroll_def
        PropBag.WriteProperty "Autocheck", mAutocheck, mAutocheck_def
        PropBag.WriteProperty "ExtendedOverlays", mExtOverlay, m_def_ExtOverlay
        PropBag.WriteProperty "Multiselect", mMultiSel, mDefMultiSel
        PropBag.WriteProperty "DisableDragDrop", mDisableDD, mDefDisableDD
        PropBag.WriteProperty "AlwaysShowExtendedVerbs", mAlwaysShowExtVerbs, mDefAlwaysShowExtVerbs
        PropBag.WriteProperty "NoIndentState", mNoIndState, mDefNoIndState
        PropBag.WriteProperty "Indentation", mIndent, mDefIndent
        PropBag.WriteProperty "AutoHScroll", mAutoHS, mDefAutoHS
        PropBag.WriteProperty "ShowHiddenItems", m_HiddenPref, m_def_HiddenPref
        PropBag.WriteProperty "ShowSuperHidden", m_SuperHiddenPref, m_def_SuperHiddenPref
        PropBag.WriteProperty "EnableShellMenu", m_EnableShellMenu, m_def_EnableShellMenu
        PropBag.WriteProperty "ShowQuickAccessOnWin10", m_Win10QA, m_def_Win10QA
        PropBag.WriteProperty "AutoExpandComputer", mExpComp, mDefExpComp
        PropBag.WriteProperty "AutoExpandLibraries", mExpLib, mDefExpLib
        PropBag.WriteProperty "DisableWow64Redirect", m_NoWow64, m_def_NoWow64
        PropBag.WriteProperty "IconSize", mIconSize, mDefIconSize
        PropBag.WriteProperty "FileExtensions", m_ForceExt, m_def_ForceExt
        PropBag.WriteProperty "ShowOnlyFileCheckboxes", mShowOnlyFileCheckbox, mDefShowOnlyFileCheckbox
        'DebugAppend "writeprops out"
    End Sub

Private Sub UserControl_InitProperties() Handles UserControl.InitProperties
    DebugAppend "UserControl_InitProperties"
    clrBack = vbWindowBackground
    clrFore = vbWindowText
    Set PropFont = Ambient.Font
    mInitialPath = mInitialPath_def
    mCheckboxes = mCheckboxes_def
    mExCheckboxes = mExCheckboxes_def
    mExplorerStyle = mExplorerStyle_def
    mShowFiles = mShowFiles_def
    mFadeExpandos = mFadeExpandos_def
    mShowSelAlw = mDefShowSelAlw
    mShowLines = mShowLines_def
    mHasButtons = mHasButtons_def
    mSingleExpand = mSingleExpand_def
    mComputerAsRoot = mComputerAsRoot_def
    mFullRowSelect = mFullRowSelect_def
    mExpandZip = mExpandZip_def
    mFilter = mFilter_def
    mFilterFilesOnly = mFilterFilesOnly_def
    mInfoTipOnFolders = mInfoTipOnFolders_def
    mInfoTipOnFiles = mInfoTipOnFiles_def
    mExpandOnLabelClick = mExpandOnLabelClick_def
    mNavSound = mNavSound_def
    mFavorites = mFavorites_def
    mSHCN = mSHCN_def
    mLabelEdit = mLabelEdit_def
    mNameColors = mNameColors_def
    mBorder = mBorder_def
    lRaiseHover = m_def_lRaiseHover
    m_TrackSel = m_def_TrackSel
    mCustomRoot = mCustomRoot_def
    mRootHasCheckbox = mRootHasCheckbox_def
    mHScroll = mHScroll_def
    mAutocheck = mAutocheck_def
    mExtOverlay = m_def_ExtOverlay
    mMultiSel = mDefMultiSel
    mDisableDD = mDefDisableDD
    mAlwaysShowExtVerbs = mDefAlwaysShowExtVerbs
    mNoIndState = mDefNoIndState
    mExpComp = mDefExpComp
    mExpLib = mDefExpLib
    mAutoHS = mDefAutoHS
    m_HiddenPref = m_def_HiddenPref
    m_SuperHiddenPref = m_def_SuperHiddenPref
    m_EnableShellMenu = m_def_EnableShellMenu
    m_Win10QA = m_def_Win10QA
    m_NoWow64 = m_def_NoWow64
    mIndent = mDefIndent
    mIconSize = mDefIconSize
    m_ForceExt = m_def_ForceExt
    mShowOnlyFileCheckbox = mDefShowOnlyFileCheckbox
DebugAppend "InitProps"
pvCreate
End Sub
        
 Private Sub UserControl_EnterFocus() Handles UserControl.EnterFocus
RaiseEvent EnterFocus
End Sub

Private Sub UserControl_ExitFocus() Handles UserControl.ExitFocus
RaiseEvent ExitFocus
End Sub
   
   
    Private Sub UserControl_Initialize() Handles UserControl.Initialize
    DebugAppend "UserControl_Initialize "
    Dim hDC As LongPtr
    hDC = GetDC(0&)
    m_ScaleX = GetDeviceCaps(hDC, LOGPIXELSX) / 96
    DebugAppend "dpix=" & GetDeviceCaps(hDC, LOGPIXELSX) / 96, 1111
    m_ScaleY = GetDeviceCaps(hDC, LOGPIXELSY) / 96
    
    ReleaseDC 0&, hDC
    
    gdipToken = InitGDIPlus()
    
    ReDim SysImgCache(0)
        ReadWindowsVersion
        IsComCtl6 = (ComCtlVersion >= 6)
        Call SetVTableHandling(Me, VTableInterfaceInPlaceActiveObject)
        gCurSelIdx = -1
        Set pDTH = New DragDropHelper
        CF_SHELLIDLIST = RegisterClipboardFormatW(StrPtr(CFSTR_SHELLIDLIST))
        CF_DROPDESCRIPTION = RegisterClipboardFormatW(StrPtr(CFSTR_DROPDESCRIPTION))
        CF_PREFERREDDROPEFFECT = RegisterClipboardFormatW(StrPtr(CFSTR_PREFERREDDROPEFFECT))
        CF_COMPUTEDDRAGIMAGE = RegisterClipboardFormatW(StrPtr(CFSTR_COMPUTEDDRAGIMAGE))
        CF_INDRAGLOOP = RegisterClipboardFormatW(StrPtr(CFSTR_INDRAGLOOP))
        m_SysClrText = GetSysColor(COLOR_WINDOWTEXT)
        Dim lp As LongPtr
        SHGetKnownFolderPath FOLDERID_Profile, KF_FLAG_DEFAULT, 0&, lp
        sUserFolder = LPWSTRtoStr(lp)
        lp = 0
        SHGetKnownFolderPath FOLDERID_Desktop, KF_FLAG_DEFAULT, 0&, lp
        sUserDesktop = LPWSTRtoStr(lp)
        'ReDim sUDLastPathSet(0)
        ReDim TVEntries(0)
        If ExplorerSettingEnabled(SSF_SHOWALLOBJECTS) Then
            mHPInExp = True
        Else
            mHPInExp = False
        End If
        If ExplorerSettingEnabled(SSF_SHOWSUPERHIDDEN) Then
            mSHPInExp = True
        Else
            mSHPInExp = False
        End If
    End Sub
    
    Private Sub UserControl_Terminate() Handles UserControl.Terminate
        DebugAppend "ShellTree Terminate Event"
        fLoad = 1
        StopNotify
        'Free full pidl records
        Dim i As Long
        On Error Resume Next
        For i = 0 To UBound(TVEntries)
            If TVEntries(i).pidlFQPar Then
                CoTaskMemFree TVEntries(i).pidlFQPar
            End If
        Next i
        For i = 0 To UBound(TVEntries)
            If TVEntries(i).pidlFQ Then
                CoTaskMemFree TVEntries(i).pidlFQ
            End If
        Next i
        Call EmptyTreeView(hTVD, False)
        
        ' Detach the image lists
        Call TreeView_SetImageList(hTVD, 0, TVSIL_NORMAL)
        Call TreeView_SetImageList(hTVD, 0, TVSIL_STATE)
        'ImageList_Destroy himlTVCheck

        Set pIML = Nothing
        Set pDTH = Nothing

        'Revoke DragDrop
        Call Detach
        Call RemoveVTableHandling(Me, VTableInterfaceInPlaceActiveObject)
        DestroyWindow hTVD
        UnSubclass UserControl.hWnd, AddressOf ShellTreeSubclassProc, UserControl.hWnd
        If hFontTV <> 0 Then
            DeleteObject hFontTV
            hFontTV = 0
        End If
        If m_NoWow64 Then RevertWow64Redir()
        FreeGDIPlus(gdipToken)
    End Sub
    
    Private Sub UserControl_Resize() Handles UserControl.Resize
        Dim RC As RECT
        Dim rcUC As RECT
        Dim rcCH As RECT
        If mBkm Then
            '... - 20 - 20
        Else
            Call GetClientRect(UserControl.hWnd, RC)
            Call GetClientRect(UserControl.ContainerHwnd, rcCH)
            DebugAppend "ResizeTreeView::hwnd=" & UserControl.hWnd & ",cthwnd=" & UserControl.ContainerHwnd & ",rc.Bottom=" & RC.Bottom & ",cy=" & UserControl.Height & ",scy=" & UserControl.ScaleHeight & ",ctcx=" & rcCH.Right & ",ctcy=" & rcCH.Bottom & ",m_ScaleX=" & m_ScaleX & ",m_ScaleY=" & m_ScaleY
            'Call SetWindowPos(hTVD, 0, 0, 0, RC.Right - 4, RC.Bottom - 4, 0)
            Call SetWindowPos(hTVD, 0, 0, 0, RC.Right, RC.Bottom, 0)
            'DebugAppend "rcuc.Bottom=" & rcUC.Bottom
        End If

    End Sub
    
    Private Sub UserControl_GotFocus() Handles UserControl.GotFocus
        SetFocusAPI hTVD
    End Sub
    
    
    Private Sub IDropTarget_DragEnter(ByVal pDataObject As IDataObject, ByVal grfKeyState As Long, ByVal pt As POINT, pdwEffect As DROPEFFECTS) Implements IDropTarget.DragEnter
            '<EhHeader>
            On Error GoTo e0
            '</EhHeader> 
        bNoDrop = False
        m_sAltDrop = ""
        If grfKeyState And MK_RBUTTON Then
            ddRightButton = True
        Else
            ddRightButton = False
        End If

        'NOTE: At first, indicate no drop until a folder is dragged over.
        If mFullRowSelect = False Then
            bNoDrop = True
            pdwEffect = DROPEFFECT_NONE
        '    SetPreferredEffect pDataObj, DROPEFFECT_NONE
            AddDropDescription pDataObject, DROPIMAGE_NONE, "Can't drop here.", ""
        End If

        skp:
        pDTH.DragEnter m_hWnd, pDataObject, pt, pdwEffect
        DebugAppend "DragEnter::Effect=" & pdwEffect
        Set mDataObj = pDataObject

        '    RaiseEvent DragEnter(pDataObj, grfKeyState, ptx, pty, pdwEffect)

        '<EhFooter>
        Exit Sub

        e0:
            DebugAppend "ucShellTree.IDropTarget_DragEnter->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
        '</EhFooter>      
    End Sub
    
    Private Sub IDropTarget_DragOver(ByVal grfKeyState As Long, ByVal pt As POINT, pdwEffect As DROPEFFECTS) Implements IDropTarget.DragOver
            '<EhHeader>
            On Error GoTo e0
            '</EhHeader> 

        'mDefEffect = GetPreferredEffect(mDataObj)

            pDTH.DragOver pt, pdwEffect
        If (xHover <> pt.x) Or (yHover <> pt.y) Then
            lHover1 = GetTickCount()
            xHover = pt.x
            yHover = pt.y
            bHoverFired = False
        Else
            If lHover1 = 0 Then 'initial run
                lHover1 = GetTickCount()
                xHover = pt.x
                yHover = pt.y
            Else
                If bHoverFired = False Then
                    lHover2 = GetTickCount()
                    If (lHover2 - lHover1) > lRaiseHover Then
                        DebugAppend "DragHover " & pt.x & "," & pt.y & ",t1=" & lHover1 & ",t2=" & lHover2
        '                RaiseEvent DragHover(ptx, pty, grfKeyState)
                        TVDragHover pt.x, pt.y, grfKeyState
                        bHoverFired = True 'set flag to not raise again until pt changes
        '                lHover1 = 0
                    End If
                End If
            End If
        End If
        Dim lPrevItemIndex As LongPtr
        Dim fValid As Long, fFolder As Long
        'pdwEffect = mDefEffect
        If DataObjSupportsFormat(mDataObj, CF_PREFERREDDROPEFFECT) Then

                pdwEffect = GetPreferredEffect(mDataObj)

        Else
            pdwEffect = DROPEFFECT_MOVE
        End If

        If bAbort Then Exit Sub
        If True Then 'was m_ActiveDrop but active drop is mandatory for this control
            lPrevItemIndex = lItemIndex
            Dim fGrp As Boolean
            Dim bNo As Boolean
            Dim sOld As String
            Dim nPrev As LongPtr
            nPrev = lItemIndex
            
            TVQueryDragOverItem pt.x, pt.y, nPrev, lItemIndex, fGrp, fValid, fFolder
            If lItemIndex <> nPrev Then
            If (lItemIndex >= 0) Then
                If fGrp Then
                    sOld = sFolder
                    TVQueryDragOverData lItemIndex, True, sFolder, bNo
                    If sOld <> sFolder Then
                        mDragOver = PathGetDisp(sFolder)
                    End If
                Else
                    sOld = sFolder
                    TVQueryDragOverData lItemIndex, False, sFolder, bNo
                    If sOld <> sFolder Then
                        mDragOver = PathGetDisp(sFolder)
                    End If

                End If
                If (Left$(sFolder, 3) = "::{") Then

                    If (Len(sFolder) > lnLibRoot) Then
                        If Left$(LCase$(sFolder), Len(sLibRoot)) = LCase$(sLibRoot) Then
                            sFolder = LibGetDefLoc2(sFolder)
                            If sFolder <> "" Then
                                'override: the item itself doesn't have the SFGAO_DROPTARGET flag
                                '          but the default location does
                                fValid = 1
                                fFolder = 1
                                TreeView_SelectDropTarget hTVD, lItemIndex
                            End If
                        End If
                    Else
                        bNo = True
                    End If
                End If
                DebugAppend "dragover set dir=" & sFolder & ",idx=" & lItemIndex & ",valid=" & fValid & ",folder=" & fFolder  ', 9
            Else
        
                    DebugAppend "QueryDragOverItem index=" & lItemIndex
                    mDragOver = ""
                    sFolder = ""
        
            End If
            End If
            If lItemIndex = -1 Then bNo = True
            If bNo Then
                pdwEffect = DROPEFFECT_NONE
                DebugAppend "DragOver::bNo=True,set->none"
            End If
            If (lItemIndex <> lPrevItemIndex) Then
            DebugAppend "IDropTarget.DragOver::New dragover item; resetting DropDesc, lPrevItem=" & lPrevItemIndex & ",cur=" & lItemIndex
        '        DebugAppend "cDropTarget.DragOver::New dragover item; resetting DropDesc", 3
                If False Then 'If bQueryTip Then

                Else
        DefaultTipSet:

                        bNoTarget = False
                        If fValid = 0 Then
                            DebugAppend "DragOver::lItemIndex=-1,set effect (NOCHANGE),cur=" & pdwEffect
                            sFolder = ""
                            mDragOver = ""
                            If bNoDrop Then
                                pdwEffect = DROPEFFECT_NONE
                            End If
        '                    bNoTarget = True
                            fFolder = 1
                        End If
                        Dim vdt As Long
                        If lItemIndex = m_hFav Then
                            fFolder = 0
                        End If
                        If fFolder = 0 Then
                            vdt = VerifyDropTarget(lItemIndex)
                            If vdt = 0 Then
                                DebugAppend "Drop target (nonfolder) failed verify"
                                fFolder = 1
                                pdwEffect = DROPEFFECT_NONE
                            End If
                            If vdt = 2 Then
                                fFolder = 1
                            End If
                            If vdt = 3 Then
                                pdwEffect = DROPEFFECT_LINK
                                DebugAppend "SetEffectLink"
                                fFolder = 1
                            End If
                        End If
                            
                        If fFolder Then
                        Select Case pdwEffect
                            Case DROPEFFECT_NONE
                                AddDropDescription mDataObj, DROPIMAGE_NONE, "Can't drop here.", ""
                            Case DROPEFFECT_COPY
                                AddDropDescription mDataObj, DROPIMAGE_COPY, IIf(mDragOver = "", "Copy here", "Copy to %1"), mDragOver
                            Case DROPEFFECT_MOVE
                                AddDropDescription mDataObj, DROPIMAGE_MOVE, IIf(mDragOver = "", "Move here", "Move to %1"), mDragOver
                            Case DROPEFFECT_LINK
                                AddDropDescription mDataObj, DROPIMAGE_MOVE, IIf(mDragOver = "", "Create shortcut here", "Create shortcut in %1"), mDragOver
                        End Select
                        Else
                            AddDropDescription mDataObj, DROPIMAGE_COPY, IIf(mDragOver = "", "Open", "Open with %1"), mDragOver
                        End If
                    End If
        '        End If
            End If
        End If
        qts:
        
        '    RaiseEvent DragOver(grfKeyState, ptx, pty, pdwEffect)

        '<EhFooter>
        Exit Sub

        e0:
            DebugAppend "ucShellTree.IDropTarget_DragOver->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
        '</EhFooter>        
    End Sub
    
    Private Sub IDropTarget_DragLeave() Implements IDropTarget.DragLeave
        pDTH.DragLeave
        TreeView_SelectDropTarget hTVD, 0&
    End Sub
    
    Private Sub IDropTarget_Drop(ByVal pDataObj As IDataObject, ByVal grfKeyState As Long, ByVal pt As POINT, pdwEffect As DROPEFFECTS) Implements IDropTarget.Drop
        DebugAppend "IDT_Drop "

        pDTH.Drop pDataObj, pt, pdwEffect
        TVHandleDrop pDataObj, pdwEffect, pt, grfKeyState
        sFolder = ""
        TreeView_SelectDropTarget hTVD, 0&
    End Sub
    
    Private Sub PropFont_FontChanged(ByVal PropertyName As String) Handles PropFont.FontChanged
        Dim OldFontHandle As LongPtr
        OldFontHandle = hFontTV
        Set mIFMain = PropFont
        Dim lftmp As LOGFONT
        GetObjectW mIFMain.hFont, LenB(lftmp), lftmp
        hFontTV = CreateFontIndirect(lftmp)
        If hTVD <> 0 Then SendMessageW hTVD, WM_SETFONT, hFontTV, ByVal 1&
        If OldFontHandle <> 0 Then DeleteObject OldFontHandle
        UserControl.PropertyChanged "Font"
    End Sub
    
    Private Sub IObjectSafety_GetInterfaceSafetyOptions(riid As UUID, pdwSupportedOptions As Long, pdwEnabledOptions As Long) Implements IObjectSafety.GetInterfaceSafetyOptions
    Const INTERFACESAFE_FOR_UNTRUSTED_CALLER As Long = &H1, INTERFACESAFE_FOR_UNTRUSTED_DATA As Long = &H2
    pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA
    pdwEnabledOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA
    End Sub
    
    Private Sub IObjectSafety_SetInterfaceSafetyOptions(riid As UUID, ByVal dwOptionSetMask As Long, ByVal dwEnabledOptions As Long) Implements IObjectSafety.SetInterfaceSafetyOptions
    End Sub

Private Sub TVHandleDrop(pdo As IDataObject, pdwEffect As DROPEFFECTS, PT As POINT, dwKeys As Long)
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim hSel As LongPtr
Dim lp As LongPtr
Dim psia As IShellItemArray
Dim siTarget As IShellItem
Dim pDT As IDropTarget
Dim lpTar As LongPtr, sTar As String
Dim sFilesOut() As String
Dim nFilesOut As Long
ReDim sFilesOut(0)
Dim lButton As Long
If ddRightButton Then
    lButton = MK_RBUTTON
Else
    lButton = MK_LBUTTON
End If

'hSel = TreeView_GetSelection(hTVD)
'lp = GetTVItemlParam(hTVD, hSel)
DebugAppend "DropTarget=" & sFolder
If sFolder = "" Then Exit Sub
SHCreateItemFromParsingName StrPtr(sFolder), Nothing, IID_IShellItem, siTarget
If (siTarget Is Nothing) = False Then
    siTarget.BindToHandler 0&, BHID_SFUIObject, IID_IDropTarget, pDT
    If (pDT Is Nothing) = False Then
        pDT.DragEnter pdo, lButton, PT, pdwEffect
        pDT.Drop pdo, lButton, PT, DROPEFFECT_MOVE Or DROPEFFECT_COPY Or DROPEFFECT_LINK
    Else
        DebugAppend "TVHandleDrop->Failed to get drop target"
    End If
    siTarget.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpTar
    sTar = LPWSTRtoStr(lpTar)
Else
    DebugAppend "TVHandleDrop->Failed to get target shell item"
End If


SHCreateShellItemArrayFromDataObject pdo, IID_IShellItemArray, psia
If (psia Is Nothing) = False Then
    Dim pEnum As IEnumShellItems
    Dim sia As IShellItem
    Dim lpc As LongPtr, szc As String
    Dim pcl As Long
    psia.EnumItems pEnum
    If (pEnum Is Nothing) = False Then
        Do While pEnum.Next(1&, sia, pcl) = S_OK
            sia.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpc
            ReDim Preserve sFilesOut(nFilesOut)
            sFilesOut(nFilesOut) = LPWSTRtoStr(lpc)
            nFilesOut = nFilesOut + 1
            pEnum.Next 1&, sia, pcl
        Loop
    End If
End If

RaiseEvent DropFiles(sFilesOut, psia, pdo, sTar, siTarget, pdwEffect, dwKeys, PT.x, PT.y)
'<EhFooter>
Exit Sub

e0:
    DebugAppend "ucShellTree.TVHandleDrop->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Sub
Private Sub SyncChecks()
'There's some bugs with item values but not visuals.
Dim i As Long
Dim uState As Long
For i = 0 To UBound(TVEntries)
    If TVEntries(i).bDeleted = False Then
        uState = 0&
        uState = TreeView_GetItemState(hTVD, TVEntries(i).hNode, TVIS_STATEIMAGEMASK)
        If (uState And TVIS_STATEIMAGEMASK) = &H1000 Then  'Unchecked
            TVEntries(i).Checked = False
            TVEntries(i).Excluded = False
        ElseIf (uState And TVIS_STATEIMAGEMASK) = &H2000 Then 'Checked
            TVEntries(i).Checked = True
            TVEntries(i).Excluded = False
        ElseIf (uState And TVIS_STATEIMAGEMASK) = &H3000 Then 'Partially checked (only subitems are checked)
            TVEntries(i).Checked = False
            TVEntries(i).Excluded = False
        ElseIf (uState And TVIS_STATEIMAGEMASK) = &H4000 Then 'Exclusion checkmark
            TVEntries(i).Checked = False
            TVEntries(i).Excluded = True
        End If
     End If
Next i
End Sub
Private Sub SetCheckedList()
ReDim gPaths(0)
nPaths = 0
'EnumPaths hTVD, m_hRoot
Dim i As Long
For i = 0 To UBound(TVEntries)
    If (TVEntries(i).Checked = True) And (TVEntries(i).bDeleted = False) Then
        ReDim Preserve gPaths(nPaths)
        gPaths(nPaths) = TVEntries(i).sFullPath
        nPaths = nPaths + 1
    End If
Next i
End Sub

Private Sub SetExCheckedList()
ReDim gExPaths(0)
nExPaths = 0
'EnumPaths hTVD, m_hRoot
Dim i As Long
For i = 0 To UBound(TVEntries)
    If (TVEntries(i).Excluded = True) And (TVEntries(i).bDeleted = False) Then
        ReDim Preserve gExPaths(nExPaths)
        gExPaths(nExPaths) = TVEntries(i).sFullPath
        nExPaths = nExPaths + 1
    End If
Next i
End Sub

Private Sub SetSelection(n As LongPtr, hi As LongPtr)
Dim lp As LongPtr
Dim ppidlp As LongPtr
If n = -1 Then
    Set siSelected = Nothing
    sSelectedItem = ""
    Exit Sub
End If
If TVEntries(n).sFullPath = "0" Then
    DebugAppend "SetSel->PathName 0 selected"
    If mComputerAsRoot Then
        SHGetKnownFolderItem FOLDERID_ComputerFolder, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siSelected
    Else
        SHGetKnownFolderItem FOLDERID_Desktop, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siSelected
    End If
ElseIf TVEntries(n).sFullPath = "1" Then
    DebugAppend "SetSel->PathName 1 selected"
    If bQkAc Then
        SHCreateItemFromParsingName StrPtr(sQuickAccess), Nothing, IID_IShellItem, siSelected
    Else
        SHGetKnownFolderItem FOLDERID_Favorites, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siSelected
    End If
Else
    If mFavorites Then
        DebugAppend "node=" & TVEntries(n).hParentNode & ",fav=" & m_hFav & ",txt=" & TVEntries(1).sName & ",tgt=" & TVEntries(n).sLinkTarget
        If TVEntries(n).hParentNode = m_hFav Then
            If TVEntries(n).LinkPIDL Then
                DebugAppend "Using link pidl"
                SHCreateItemFromIDList TVEntries(n).LinkPIDL, IID_IShellItem, siSelected
            Else
                SHCreateItemFromParsingName StrPtr(TVEntries(n).sLinkTarget), Nothing, IID_IShellItem, siSelected
                If (siSelected Is Nothing) Then
                    DebugAppend "SetSelection::ParsingPath->ShellItem failed, trying to load from pidls...", 3
                    If (TVEntries(n).pidlFQPar <> 0&) And (TVEntries(n).pidlRel <> 0&) Then
                        ppidlp = ILCombine(TVEntries(n).pidlFQPar, TVEntries(n).pidlRel)
                        SHCreateItemFromIDList ppidlp, IID_IShellItem, siSelected
                        If (siSelected Is Nothing) = False Then
                            DebugAppend "SetSelection::LoadFromPidl->Success!", 3
                        Else
                            DebugAppend "SetSelection::LoadFromPidl->Failed.", 3
                        End If
                    Else
                        DebugAppend "SetSelection::LoadFromPidl->Parent or child pidl not set.", 3
                    End If
                End If
            End If
        Else
            If TVEntries(n).pidlFQ Then
                SHCreateItemFromIDList TVEntries(n).pidlFQ, IID_IShellItem, siSelected
            Else
                SHCreateItemFromParsingName StrPtr(TVEntries(n).sFullPath), Nothing, IID_IShellItem, siSelected
            End If
            If (siSelected Is Nothing) Then
                DebugAppend "SetSelection::ParsingPath->ShellItem failed, trying to load from pidls...", 3
                If (TVEntries(n).pidlFQPar <> 0&) And (TVEntries(n).pidlRel <> 0&) Then
                    ppidlp = ILCombine(TVEntries(n).pidlFQPar, TVEntries(n).pidlRel)
                    SHCreateItemFromIDList ppidlp, IID_IShellItem, siSelected
                    If (siSelected Is Nothing) = False Then
                        DebugAppend "SetSelection::LoadFromPidl->Success!", 3
                    Else
                        DebugAppend "SetSelection::LoadFromPidl->Failed.", 3
                    End If
                Else
                    DebugAppend "SetSelection::LoadFromPidl->Parent or child pidl not set.", 3
                End If
            End If
        End If
    Else
        If TVEntries(n).pidlFQ Then
            SHCreateItemFromIDList TVEntries(n).pidlFQ, IID_IShellItem, siSelected
        Else
            SHCreateItemFromParsingName StrPtr(TVEntries(n).sFullPath), Nothing, IID_IShellItem, siSelected
        End If
        If (siSelected Is Nothing) Then
            DebugAppend "SetSelection::ParsingPath->ShellItem failed, trying to load from pidls...", 3
            If (TVEntries(n).pidlFQPar <> 0&) And (TVEntries(n).pidlRel <> 0&) Then
                ppidlp = ILCombine(TVEntries(n).pidlFQPar, TVEntries(n).pidlRel)
                SHCreateItemFromIDList ppidlp, IID_IShellItem, siSelected
                If (siSelected Is Nothing) = False Then
                    DebugAppend "SetSelection::LoadFromPidl->Success!", 3
                Else
                    DebugAppend "SetSelection::LoadFromPidl->Failed.", 3
                End If
            Else
                DebugAppend "SetSelection::LoadFromPidl->Parent or child pidl not set.", 3
            End If
        End If
    End If
End If
        
siSelected.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lp
sSelectedItem = LPWSTRtoStr(lp)
Dim lpName As LongPtr, sName As String
Dim bFl As Boolean
siSelected.GetDisplayName SIGDN_NORMALDISPLAY, lpName
sName = LPWSTRtoStr(lpName)
DebugAppend "SetSel(" & n & ") " & sName & ",path=" & sSelectedItem
Dim lAtr As SFGAOF
siSelected.GetAttributes SFGAO_FOLDER, lAtr
If (lAtr And SFGAO_FOLDER) = SFGAO_FOLDER Then
    bFl = True
End If

If (fLoad = 0&) Then RaiseEvent ItemSelect(sName, sSelectedItem, bFl, hi)
If (fLoad = 0&) Then RaiseEvent ItemSelectByShellItem(siSelected, sName, sSelectedItem, bFl, hi)

If ppidlp Then CoTaskMemFree ppidlp
End Sub

Private Function NormalizePath(sz As String) As String
'Our add routine doesn't include the trailing slash except for roots
'so normalize means removing it
If Len(sz) > 4 Then
    If Right$(sz, 1) = "\" Then
        sz = Left$(sz, Len(sz) - 1)
    End If
End If
NormalizePath = sz
End Function

Public Function PathSetCheck(ByVal sPath As String, bChecked As Boolean, Optional bInsertIfNeeded As Boolean = False) As Long
'sets check state and returns old state
'bInsertIfNeeded will expand all needed folders to show the item
If mCheckboxes = False Then Exit Function
Dim fChk As Long
Dim idx As Long
sPath = NormalizePath(sPath)
idx = GetIndexFromPath(sPath)

If (idx = -1) And (bInsertIfNeeded = True) Then
    DebugAppend "PathSetCheck->Open to path"
    OpenToPath sPath, False, False
    idx = GetIndexFromPath(sPath)
End If
DebugAppend "PathSetCheck->AfterInsertBlock idx=" & idx
If idx < 1 Then Exit Function
If TVEntries(idx).bDeleted Then Exit Function

fChk = TreeView_GetCheckState(hTVD, TVEntries(idx).hNode)
DebugAppend "PathSetCheck->idx=" & idx & ",cur=" & fChk
If bChecked Then
    If fChk = 1 Then '1=unchecked,2=checked,3=partial (0=no box at all)
        TreeView_SetCheckState hTVD, TVEntries(idx).hNode, 1
    End If
Else
    If fChk = 2 Then
        TreeView_SetCheckState hTVD, TVEntries(idx).hNode, 0
    End If
End If
PathSetCheck = fChk
End Function

Public Function PathGetCheck(ByVal sPath As String) As Long
'-1=checkbox mode off, -2=path not found, 0=no box on item, 1=unchecked, 2=checked, 3=partial check
PathGetCheck = -1
If mCheckboxes = False Then Exit Function
Dim idx As Long

PathGetCheck = -2
sPath = NormalizePath(sPath)
idx = GetIndexFromPath(sPath)
If idx < 1 Then Exit Function
If TVEntries(idx).bDeleted Then Exit Function

PathGetCheck = TreeView_GetCheckState(hTVD, TVEntries(idx).hNode)

End Function

'***************************************************
'Begin Control Properties

Public Property Get BackColor() As stdole.OLE_COLOR: BackColor = clrBack: End Property
Attribute BackColor.VB_Description = "Set the background color of the TreeView."
Public Property Let BackColor(ByVal val As stdole.OLE_COLOR)
If val = &HFFFFFFFF Then Exit Property
clrBack = val
Dim clrt As Long
OleTranslateColor clrBack, 0&, clrt
SendMessageW hTVD, TVM_SETBKCOLOR, 0, ByVal clrt
UserControl.Refresh
'RedrawWindow UserControl.hWnd, 0, 0, RDW_UPDATENOW Or RDW_INVALIDATE Or RDW_ERASE Or RDW_ALLCHILDREN
UserControl.PropertyChanged "BackColor"

End Property
Public Property Get ForeColor() As stdole.OLE_COLOR: ForeColor = clrFore: End Property
Attribute ForeColor.VB_Description = "Set the color of the text in the TreeView."
Public Property Let ForeColor(ByVal val As stdole.OLE_COLOR)
clrFore = val
Dim clrt As Long
OleTranslateColor clrFore, 0&, clrt
SendMessage hTVD, TVM_SETTEXTCOLOR, 0, ByVal clrt
UserControl.Refresh
RedrawWindow UserControl.hWnd, 0, 0, RDW_UPDATENOW Or RDW_INVALIDATE Or RDW_ERASE Or RDW_ALLCHILDREN
UserControl.PropertyChanged "ForeColor"
End Property

Public Property Get Font() As StdFont
Attribute Font.VB_Description = "Sets the font for the TreeView items. "
Set Font = PropFont
End Property

Public Property Let Font(ByVal NewFont As StdFont)
Set Me.Font = NewFont
End Property

Public Property Set Font(ByVal NewFont As StdFont)
If NewFont Is Nothing Then Set NewFont = Ambient.Font
Dim OldFontHandle As LongPtr
Set PropFont = NewFont
OldFontHandle = hFontTV
Set mIFMain = PropFont
Dim lftmp As LOGFONT
GetObjectW mIFMain.hFont, LenB(lftmp), lftmp
hFontTV = CreateFontIndirect(lftmp)
If hTVD <> 0 Then SendMessageW hTVD, WM_SETFONT, hFontTV, ByVal 1&
If OldFontHandle <> 0 Then DeleteObject OldFontHandle
UserControl.PropertyChanged "Font"
End Property

Public Property Get Enabled() As Boolean: Enabled = UserControl.Enabled: End Property
Attribute Enabled.VB_Description = "Set whether or not the control is enabled."
Public Property Let Enabled(ByVal Value As Boolean)
UserControl.Enabled = Value
If hTVD Then EnableWindow hTVD, IIf(Value, 1, 0)
UserControl.PropertyChanged "Enabled"
End Property
Public Property Get Checkboxes() As Boolean: Checkboxes = mCheckboxes: End Property
Attribute Checkboxes.VB_Description = "Show checkboxes next to the item names."
Public Property Let Checkboxes(bVal As Boolean)
If bVal <> mCheckboxes Then
    mCheckboxes = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyleEx As ucst_TV_Ex_Styles
    
    dwStyleEx = TVS_EX_PARTIALCHECKBOXES
    If mCheckboxes Then
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
    Else
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
    End If
End If
End Property
Public Property Get ExclusionChecks() As Boolean: ExclusionChecks = mExCheckboxes: End Property
Attribute ExclusionChecks.VB_Description = "Adds an additional checkbox state, a red x. Checkboxes must be enabled for this to have an effect."
Public Property Let ExclusionChecks(bVal As Boolean)
If bVal <> mExCheckboxes Then
    mExCheckboxes = bVal
    If mCheckboxes = False Then Exit Property
    If mExCheckboxes Then
        Dim dwStyleEx As ucst_TV_Ex_Styles
        
        dwStyleEx = TVS_EX_EXCLUSIONCHECKBOXES
        If mCheckboxes Then
            Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
        Else
            Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
        End If
    End If
End If
End Property
Public Property Get ShowSelAlways() As Boolean: ShowSelAlways = mShowSelAlw: End Property
Attribute ShowSelAlways.VB_Description = "Show selected item(s) when the control is out of focus."
Public Property Let ShowSelAlways(bVal As Boolean)
If mShowSelAlw <> bVal Then
    mShowSelAlw = bVal
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mShowSelAlw Then
        dwStyle = dwStyle Or TVS_SHOWSELALWAYS
    Else
        dwStyle = dwStyle And Not TVS_SHOWSELALWAYS
    End If
    Call SetWindowLong(hTVD, GWL_STYLE, dwStyle)
End If
End Property
Public Property Get TrackSelect() As Boolean: TrackSelect = m_TrackSel: End Property
Attribute TrackSelect.VB_Description = "Set whether hot tracking is enabled."
Public Property Let TrackSelect(ByVal bVal As Boolean)
If m_TrackSel <> bVal Then
    m_TrackSel = bVal
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If m_TrackSel Then
        dwStyle = dwStyle Or TVS_TRACKSELECT
    Else
        dwStyle = dwStyle And Not TVS_TRACKSELECT
    End If
    Call SetWindowLong(hTVD, GWL_STYLE, dwStyle)
End If
End Property
Public Property Get MultiSelect() As Boolean: MultiSelect = mMultiSel: End Property
Attribute MultiSelect.VB_Description = "Enables the Mutlselect extended style. WARNING: This style is listed as 'Not supported' by MSDN, so is subject to no longer working at any time."
Public Property Let MultiSelect(bVal As Boolean)
Dim dwStyleEx As ucst_TV_Ex_Styles
If bVal <> mMultiSel Then
    mMultiSel = bVal
    dwStyleEx = TVS_EX_MULTISELECT
    If mMultiSel Then
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
    Else
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
    End If
End If
End Property
Public Property Get DisableDragDrop() As Boolean: DisableDragDrop = mDisableDD: End Property
Attribute DisableDragDrop.VB_Description = "Disables drag and drop operations."
Public Property Let DisableDragDrop(bVal As Boolean)
If bVal <> mDisableDD Then
    mDisableDD = bVal
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mDisableDD Then
        dwStyle = dwStyle Or TVS_DISABLEDRAGDROP
    Else
        dwStyle = dwStyle And Not TVS_DISABLEDRAGDROP
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property
Public Property Get Autocheck() As Boolean: Autocheck = mAutocheck: End Property
Attribute Autocheck.VB_Description = "Change parent and child states to reflect checkbox states."
Public Property Let Autocheck(bVal As Boolean)
If bVal <> mAutocheck Then
    mAutocheck = bVal
    If mCheckboxes = False Then Exit Property
    If mAutocheck Then
        Dim dwStyleEx As ucst_TV_Ex_Styles
        Dim dwStyle As ucst_TV_Styles
        
        If mAutocheck Then
            If mExCheckboxes Then
                dwStyleEx = TVS_EX_EXCLUSIONCHECKBOXES
            Else
                dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
                dwStyle = dwStyle And Not TVS_CHECKBOXES
                SetWindowLong hTVD, GWL_STYLE, dwStyle
            End If
            dwStyleEx = dwStyleEx Or TVS_EX_PARTIALCHECKBOXES
            Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
        Else
            dwStyleEx = TVS_EX_PARTIALCHECKBOXES
            If mExCheckboxes Then
                dwStyleEx = dwStyleEx Or TVS_EX_EXCLUSIONCHECKBOXES
                Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
            Else
                Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
                dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
                dwStyle = dwStyle Or TVS_CHECKBOXES
                SetWindowLong hTVD, GWL_STYLE, dwStyle
            End If
        End If
    End If
End If
End Property
Public Property Get ExplorerStyle() As Boolean: ExplorerStyle = mExplorerStyle: End Property
Attribute ExplorerStyle.VB_Description = "Apply the Explorer visual style to the tree."
Public Property Let ExplorerStyle(bVal As Boolean)
If bVal <> mExplorerStyle Then
    mExplorerStyle = bVal
    If mExplorerStyle Then
        SetWindowTheme hTVD, StrPtr("explorer"), 0&
    Else
        SetWindowTheme hTVD, StrPtr(" "), 0&
    End If
End If
End Property
Public Property Get ShowFiles() As Boolean: ShowFiles = mShowFiles: End Property
Attribute ShowFiles.VB_Description = "Show files in the tree in addition to folders."
Public Property Let ShowFiles(bVal As Boolean): mShowFiles = bVal: End Property
Public Property Get FileExtensions() As ST_EXT_PREF: FileExtensions = m_ForceExt: End Property
Attribute FileExtensions.VB_Description = "When files are shown, sets whether to always show file extensions or use Explorer's setting."
Public Property Let FileExtensions(lVal As ST_EXT_PREF): m_ForceExt = lVal: End Property
Public Property Get ExtendedOverlays() As Boolean: ExtendedOverlays = mExtOverlay: End Property
Attribute ExtendedOverlays.VB_Description = "Show the extended overlays sometimes found in programs like TortoiseSVN, Dropbox, or Github. WARNING: Extreme performance cost, reduces folder load times by 10-100x."
Public Property Let ExtendedOverlays(bVal As Boolean): mExtOverlay = bVal: End Property
Public Property Get FadingExpandos() As Boolean: FadingExpandos = mFadeExpandos: End Property
Attribute FadingExpandos.VB_Description = "Toggle whether or not the expando buttons fade in/fade out as focus changes."
Public Property Let FadingExpandos(bVal As Boolean)
If bVal <> mFadeExpandos Then
    mFadeExpandos = bVal
    Dim dwStyleEx As ucst_TV_Ex_Styles
    dwStyleEx = TVS_EX_FADEINOUTEXPANDOS
    If mFadeExpandos Then
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
    Else
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
    End If
End If
End Property
Public Property Get NoIndentState() As Boolean: NoIndentState = mNoIndState: End Property
Attribute NoIndentState.VB_Description = "Do not indent the tree view for the expando buttons."
Public Property Let NoIndentState(bVal As Boolean)
If bVal <> mNoIndState Then
    mNoIndState = bVal
    Dim dwStyleEx As ucst_TV_Ex_Styles
    dwStyleEx = TVS_EX_NOINDENTSTATE
    If mNoIndState Then
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
    Else
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
    End If
End If
End Property
Public Property Get AutoHScroll() As Boolean: AutoHScroll = mAutoHS: End Property
Attribute AutoHScroll.VB_Description = "Remove the horizontal scrollbar for some positions."
Public Property Let AutoHScroll(bVal As Boolean)
If bVal <> mAutoHS Then
    mAutoHS = bVal
    Dim dwStyleEx As ucst_TV_Ex_Styles
    dwStyleEx = TVS_EX_AUTOHSCROLL
    If mAutoHS Then
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)
    Else
        Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal 0&)
    End If
End If
End Property
Public Property Get FullRowSelect() As Boolean: FullRowSelect = mFullRowSelect: End Property
Attribute FullRowSelect.VB_Description = "Hilite the entire row instead of just the item name."
Public Property Let FullRowSelect(bVal As Boolean)
If bVal <> mFullRowSelect Then
    mFullRowSelect = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mFullRowSelect Then
        dwStyle = dwStyle Or TVS_FULLROWSELECT
    Else
        dwStyle = dwStyle And Not TVS_FULLROWSELECT
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property
Public Property Get ComputerAsRoot() As Boolean: ComputerAsRoot = mComputerAsRoot: End Property
Attribute ComputerAsRoot.VB_Description = "Use the Computer folder (drive list) instead of the Desktop as the root of the tree."
Public Property Let ComputerAsRoot(bVal As Boolean)
If mComputerAsRoot <> bVal Then
    mComputerAsRoot = bVal
    If Ambient.UserMode Then ResetTreeView
End If
End Property
Public Property Get SingleExpand() As Boolean: SingleExpand = mSingleExpand: End Property
Attribute SingleExpand.VB_Description = "Allow only one item to be expanded at a time. The previous item is collapsed when a new one expands."
Public Property Let SingleExpand(bVal As Boolean)
If bVal <> mSingleExpand Then
    mSingleExpand = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mSingleExpand Then
        dwStyle = dwStyle Or TVS_SINGLEEXPAND
    Else
        dwStyle = dwStyle And Not TVS_SINGLEEXPAND
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property
Public Property Get HasButtons() As Boolean: HasButtons = mHasButtons: End Property
Attribute HasButtons.VB_Description = "Sets whether expando buttons appear next to items with subfolders."
Public Property Let HasButtons(bVal As Boolean)
If bVal <> mHasButtons Then
    mHasButtons = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mHasButtons Then
        dwStyle = dwStyle Or TVS_HASBUTTONS
    Else
        dwStyle = dwStyle And Not TVS_HASBUTTONS
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property
Public Property Get ShowOnlyFileCheckbox() As Boolean: Return mShowOnlyFileCheckbox: End Property
Public Property Let ShowOnlyFileCheckboxes(ByVal bValue As Boolean)
    mShowOnlyFileCheckbox = bValue
End Property
Property Get IconSize() As Long: IconSize = mIconSize: End Property
Attribute IconSize.VB_Description = "Gets/sets the folder/file icon size in the TreeView. This will be scaled by system zoom."
Public Property Let IconSize(cxy As Long)
    If cxy <> mIconSize Then
        mIconSize = cxy
    End If
End Property
Public Property Get ShowLines() As Boolean: ShowLines = mShowLines: End Property
Attribute ShowLines.VB_Description = "Show lines connecting the levels of the tree. Works best when ExplorerStyle is disabled."
Public Property Let ShowLines(bVal As Boolean)
If bVal <> mShowLines Then
    mShowLines = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mShowLines Then
        dwStyle = dwStyle Or TVS_HASLINES
    Else
        dwStyle = dwStyle And Not TVS_HASLINES
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property
Public Property Get ExpandZip() As Boolean: ExpandZip = mExpandZip: End Property
Attribute ExpandZip.VB_Description = "Display/expand zip/cab files like a folder."
Public Property Let ExpandZip(bVal As Boolean): mExpandZip = bVal: End Property
Public Property Get ItemFilter() As String: ItemFilter = mFilter: End Property
Attribute ItemFilter.VB_Description = "Set a filter such that item names not matching are not shown in the tree."
Public Property Let ItemFilter(sFilter As String): mFilter = sFilter: End Property
Public Property Get ItemFilterFilesOnly() As Boolean: ItemFilterFilesOnly = mFilterFilesOnly: End Property
Attribute ItemFilterFilesOnly.VB_Description = "Apply the ItemFilter restriction only to files (ShowFiles), not folders."
Public Property Let ItemFilterFilesOnly(bVal As Boolean): mFilterFilesOnly = bVal: End Property
Public Property Get InfoTipOnFolders() As Boolean: InfoTipOnFolders = mInfoTipOnFolders: End Property
Attribute InfoTipOnFolders.VB_Description = "Show a tooltip with item information on mouseover."
Public Property Let InfoTipOnFolders(bVal As Boolean): mInfoTipOnFolders = bVal: End Property
Public Property Get InfoTipOnFiles() As Boolean: InfoTipOnFiles = mInfoTipOnFiles: End Property
Attribute InfoTipOnFiles.VB_Description = "Show a tooltip with several properties based on the file type on mouseover."
Public Property Let InfoTipOnFiles(bVal As Boolean): mInfoTipOnFiles = bVal: End Property
Public Property Get ActiveDropHoverTime() As Long: ActiveDropHoverTime = lRaiseHover: End Property
Attribute ActiveDropHoverTime.VB_Description = "During a drag/drop operation, how long (in ms) the mouse must not move to trigger a hover event."
Public Property Let ActiveDropHoverTime(lMillisecs As Long): lRaiseHover = lMillisecs: End Property
Public Property Get SingleClickExpand() As Boolean: SingleClickExpand = mExpandOnLabelClick: End Property
Attribute SingleClickExpand.VB_Description = "Expand/collapse when the item name is clicked; otherwise, you must click the expando button or double-click the name to expand/collapse."
Public Property Let SingleClickExpand(bVal As Boolean): mExpandOnLabelClick = bVal: End Property
Public Property Get PlayNavigationSound() As Boolean: PlayNavigationSound = mNavSound: End Property
Attribute PlayNavigationSound.VB_Description = "Play the click sound you hear in Explorer when selecting a new item."
Public Property Let PlayNavigationSound(bVal As Boolean): mNavSound = bVal: End Property
Public Property Get AlwaysShowExtendedVerbs() As Boolean: AlwaysShowExtendedVerbs = mAlwaysShowExtVerbs: End Property
Attribute AlwaysShowExtendedVerbs.VB_Description = "Always show extended verbs in the shell context menu, otherwise Shift must be pressed when bringing up the menu."
Public Property Let AlwaysShowExtendedVerbs(bVal As Boolean): mAlwaysShowExtVerbs = bVal: End Property
Public Property Get ShowHiddenItems() As ST_HDN_PREF: ShowHiddenItems = m_HiddenPref: End Property
Public Property Let ShowHiddenItems(lVal As ST_HDN_PREF): m_HiddenPref = lVal: End Property
Public Property Get ShowSuperHidden() As ST_SPRHDN_PREF: ShowSuperHidden = m_SuperHiddenPref: End Property
Attribute ShowSuperHidden.VB_Description = "Show protected operating system files (marked Hidden+System)"
Public Property Let ShowSuperHidden(lVal As ST_SPRHDN_PREF): m_SuperHiddenPref = lVal: End Property
Public Property Get ShowFavorites() As Boolean: ShowFavorites = mFavorites: End Property
Attribute ShowFavorites.VB_Description = "Show the 'Favorites' link group at the top like Explorer."
Public Property Let ShowFavorites(bVal As Boolean)
If mFavorites <> bVal Then
    mFavorites = bVal
    If mFavorites Then
        If Ambient.UserMode Then ResetTreeView
    End If
End If
End Property
Public Property Get EnableShellMenu() As Boolean: EnableShellMenu = m_EnableShellMenu: End Property
Public Property Let EnableShellMenu(bVal As Boolean)
m_EnableShellMenu = bVal
'UserControl.PropertyChanged "EnableShellMenu"
End Property
Public Property Get SelectedItem() As String: SelectedItem = sSelectedItem: End Property
Public Property Get SelectedShellItem() As IShellItem: Set SelectedShellItem = siSelected: End Property
Public Property Get hWndTreeView() As LongPtr: hWndTreeView = hTVD: End Property
Public Property Get hWndUserControl() As LongPtr: hWndUserControl = UserControl.hWnd: End Property
'Public Property Get Border() As Boolean: Border = mBorder: End Property
'Public Property Let Border(bVal As Boolean): mBorder = bVal: End Property
Public Property Get BorderStyle() As ST_BORDERSTYLE: BorderStyle = mBorder: End Property
Attribute BorderStyle.VB_Description = "Provides options for the type of border around the tree."
Public Property Let BorderStyle(lVal As ST_BORDERSTYLE)
If lVal <> mBorder Then
    mBorder = lVal
    Dim dwStyle As WindowStyles, dwExStyle As WindowStylesEx
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    dwExStyle = CLng(GetWindowLong(hTVD, GWL_EXSTYLE))
    Select Case mBorder
        Case STBS_None
            dwStyle = dwStyle And Not WS_BORDER
            dwStyle = dwStyle And Not WS_THICKFRAME
            dwExStyle = dwExStyle And Not WS_EX_CLIENTEDGE
        Case STBS_Standard
            dwStyle = dwStyle Or WS_BORDER
            dwStyle = dwStyle And Not WS_THICKFRAME
            dwExStyle = dwExStyle And Not WS_EX_CLIENTEDGE
        Case STBS_Thick
            dwStyle = dwStyle Or WS_BORDER
            dwStyle = dwStyle And Not WS_THICKFRAME
            dwExStyle = dwExStyle Or WS_EX_CLIENTEDGE
        Case STBS_Thicker
            dwStyle = dwStyle Or WS_BORDER
            dwStyle = dwStyle Or WS_THICKFRAME
            dwExStyle = dwExStyle Or WS_EX_CLIENTEDGE
    End Select
    Call SetWindowLong(hTVD, GWL_STYLE, dwStyle)
    Call SetWindowLong(hTVD, GWL_EXSTYLE, dwExStyle)
    SetWindowPos hTVD, 0&, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_FRAMECHANGED
End If
End Property
Public Property Get MonitorDirChanges() As Boolean: MonitorDirChanges = mSHCN: End Property
Attribute MonitorDirChanges.VB_Description = "Monitor shell notifications for files/folders created, deleted, renamed, etc, and update the tree accordingly if needed."
Public Property Let MonitorDirChanges(bVal As Boolean)
If bVal <> mSHCN Then
    If bVal Then
        mSHCN = True
        StartNotify UserControl.hWnd
    Else
        mSHCN = False
        StopNotify
    End If
End If
End Property
Public Property Get LabelEditRename() As Boolean: LabelEditRename = mLabelEdit: End Property
Attribute LabelEditRename.VB_Description = "Enables label edit, which renames the folders/files in Windows as well."
Public Property Let LabelEditRename(bVal As Boolean)
If bVal <> mLabelEdit Then
    mLabelEdit = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mLabelEdit Then
        dwStyle = dwStyle Or TVS_EDITLABELS
    Else
        dwStyle = dwStyle And Not TVS_EDITLABELS
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property
Public Property Get HorizontalScroll() As Boolean: HorizontalScroll = mHScroll: End Property
Attribute HorizontalScroll.VB_Description = "Sets whether the tree expands such that horizontal scrolling isn't needed."
Public Property Let HorizontalScroll(bVal As Boolean)
If bVal <> mHScroll Then
    mHScroll = bVal
    If hTVD = 0& Then Exit Property
    Dim dwStyle As ucst_TV_Styles
    dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
    If mHScroll Then
        dwStyle = dwStyle And Not TVS_NOHSCROLL
    Else
        dwStyle = dwStyle Or TVS_NOHSCROLL
    End If
    SetWindowLong hTVD, GWL_STYLE, dwStyle
End If
End Property

Public Property Get NameColors() As Boolean: NameColors = mNameColors: End Property
Attribute NameColors.VB_Description = "Show Windows encrypted files in green, and Windows compressed files in blue. These are the attributes set in file properties."
Public Property Let NameColors(bVal As Boolean): mNameColors = bVal: End Property
Public Property Get InitialPath() As String: InitialPath = mInitialPath: End Property
Attribute InitialPath.VB_Description = "Deprecated. Use OpenToPath."
Attribute InitialPath.VB_MemberFlags = "400"
Public Property Let InitialPath(sPath As String)
mInitialPath = sPath
If sPath <> "" Then
    OpenToPath sPath, False
End If
End Property
Public Property Get CustomRoot() As String: CustomRoot = mCustomRoot: End Property
Attribute CustomRoot.VB_Description = "Specify a custom location to use as the root folder."
Public Property Let CustomRoot(sRoot As String)
mCustomRoot = sRoot
ResetTreeView
End Property
Public Property Get RootHasCheckbox() As Boolean: RootHasCheckbox = mRootHasCheckbox: End Property
Attribute RootHasCheckbox.VB_Description = "Sets whether or not a checkbox appears next to the root item when checkboxes are enabled."
Public Property Let RootHasCheckbox(bVal As Boolean)
If bVal <> mRootHasCheckbox Then
    mRootHasCheckbox = bVal
    bSetParents = True
    If mRootHasCheckbox Then
        If Ambient.UserMode Then
            If TVNodeHasUncheckedChildren(m_hRoot) = False Then
                TreeView_SetCheckStateEx hTVD, m_hRoot, 2
            Else
                If TVNodeHasCheckedChildren(m_hRoot) Then
                    TreeView_SetCheckStateEx hTVD, m_hRoot, 3
                Else
                    TreeView_SetCheckStateEx hTVD, m_hRoot, 1
                End If
            End If
        Else
            TreeView_SetCheckStateEx hTVD, m_hRoot, 1
        End If
    Else
        TreeView_SetCheckStateEx hTVD, m_hRoot, 0
    End If
    bSetParents = False
End If
End Property
Public Property Get CheckedPaths() As Variant
    SyncChecks
    SetCheckedList
    CheckedPaths = gPaths
End Property
Public Property Get ExcludedPaths() As Variant
    SyncChecks
    SetExCheckedList
    ExcludedPaths = gExPaths
End Property
Public Property Get ShowQuickAccessOnWin10() As Boolean: ShowQuickAccessOnWin10 = m_Win10QA: End Property
Attribute ShowQuickAccessOnWin10.VB_Description = "Replace ""Favorites"" with ""Quick Access"" on Windows 10+ like Explorer. Requires ShowFavorites to be True."
Public Property Let ShowQuickAccessOnWin10(bShow As Boolean)
m_Win10QA = bShow
End Property
Public Property Get AutoExpandComputer() As Boolean: AutoExpandComputer = mExpComp: End Property
Attribute AutoExpandComputer.VB_Description = "When the root is Desktop, automatically expand Computer/ThisPC in the tree."
Public Property Let AutoExpandComputer(bVal As Boolean)
mExpComp = bVal
End Property
Public Property Get AutoExpandLibraries() As Boolean: AutoExpandLibraries = mExpLib: End Property
Attribute AutoExpandLibraries.VB_Description = "When the root is Desktop, automatically expand Libraries in the tree."
Public Property Let AutoExpandLibraries(bVal As Boolean)
mExpLib = bVal
End Property
Public Property Get DisableWow64Redirect() As Boolean: DisableWow64Redirect = m_NoWow64: End Property
Attribute DisableWow64Redirect.VB_Description = "Disables file system redirection for 32bit build on 64-bit systems. Ignored in 64bit builds."
Public Property Let DisableWow64Redirect(bVal As Boolean)
If bVal = m_NoWow64 Then Exit Property
m_NoWow64 = bVal
If m_NoWow64 Then
    DisableWow64Redir
Else
    RevertWow64Redir
End If
End Property
Public Property Get CheckedPathCount() As Long
    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
'End Control Properties
'********************************************************

Public Sub CheckedItemsExpand()
Dim i As Long
For i = 0 To UBound(TVEntries)
    If (TVEntries(i).Checked = True) And (TVEntries(i).bDeleted = False) Then
        SendMessage hTVD, TVM_EXPAND, TVE_EXPAND, ByVal TVEntries(i).hNode
    End If
Next i
End Sub
Public Sub CheckedItemsCollapse()
Dim i As Long
For i = 0 To UBound(TVEntries)
    If (TVEntries(i).Checked = True) And (TVEntries(i).bDeleted = False) Then
        SendMessage hTVD, TVM_EXPAND, TVE_COLLAPSE, ByVal TVEntries(i).hNode
    End If
Next i
End Sub
Public Sub CheckedItemsToggle()
Dim i As Long
For i = 0 To UBound(TVEntries)
    If (TVEntries(i).Checked = True) And (TVEntries(i).bDeleted = False) Then
        SendMessage hTVD, TVM_EXPAND, TVE_TOGGLE, ByVal TVEntries(i).hNode
    End If
Next i
End Sub

Private Sub dbg_stringbytes(s As String, Optional bOut As Boolean = False)
Dim i As Long
Dim z As String
For i = 1 To Len(s)
    z = z & Format$(Hex$(AscW(Mid(s, i, 1))), "00") & " "
Next i
'If bOut Then
    DebugAppend "StringBytes(" & s & ")", 9
    DebugAppend z, 9
'Else
'    Debug.Print "StringBytes(" & s & ")"
'    Debug.Print z
'End If
End Sub

Private Sub dbg_printstrarr(sAr() As String, bJn As Boolean)
If bJn Then
    DebugAppend Join(sAr, ",")
Else
    Dim i As Long
    For i = LBound(sAr) To UBound(sAr)
        DebugAppend "Array(" & CStr(i) & ")=" & sAr(i)
    Next i
End If
End Sub

Private Function dbg_sfgao_tostring(atr As SFGAOF) As String
Dim sOut As String
If (atr And SFGAO_BROWSABLE) = SFGAO_BROWSABLE Then sOut = sOut & "SFGAO_BROWSEABLE,"
If (atr And SFGAO_CANCOPY) = SFGAO_CANCOPY Then sOut = sOut & "SFGAO_CANCOPY,"
If (atr And SFGAO_CANDELETE) = SFGAO_CANDELETE Then sOut = sOut & "SFGAO_CANDELETE,"
If (atr And SFGAO_CANLINK) = SFGAO_CANLINK Then sOut = sOut & "SFGAO_CANLINK,"
If (atr And SFGAO_CANMONIKER) = SFGAO_CANMONIKER Then sOut = sOut & "SFGAO_CANMONIKER,"
If (atr And SFGAO_CANMOVE) = SFGAO_CANMOVE Then sOut = sOut & "SFGAO_CANMOVE,"
If (atr And SFGAO_CANRENAME) = SFGAO_CANRENAME Then sOut = sOut & "SFGAO_CANRENAME,"
If (atr And SFGAO_COMPRESSED) = SFGAO_COMPRESSED Then sOut = sOut & "SFGAO_COMPRESSED,"
If (atr And SFGAO_DROPTARGET) = SFGAO_DROPTARGET Then sOut = sOut & "SFGAO_DROPTARGET,"
If (atr And SFGAO_ENCRYPTED) = SFGAO_ENCRYPTED Then sOut = sOut & "SFGAO_ENCRYPTED,"
If (atr And SFGAO_FILESYSANCESTOR) = SFGAO_FILESYSANCESTOR Then sOut = sOut & "SFGAO_FILESYSANCESTOR,"
If (atr And SFGAO_FILESYSTEM) = SFGAO_FILESYSTEM Then sOut = sOut & "SFGAO_FILESYSTEM,"
If (atr And SFGAO_FOLDER) = SFGAO_FOLDER Then sOut = sOut & "SFGAO_FOLDER,"
If (atr And SFGAO_GHOSTED) = SFGAO_GHOSTED Then sOut = sOut & "SFGAO_GHOSTED,"
If (atr And SFGAO_HASPROPSHEET) = SFGAO_HASPROPSHEET Then sOut = sOut & "SFGAO_HASPROPSHEET,"
If (atr And SFGAO_HASSTORAGE) = SFGAO_HASSTORAGE Then sOut = sOut & "SFGAO_HASSTORAGE,"
If (atr And SFGAO_HASSUBFOLDER) = SFGAO_HASSUBFOLDER Then sOut = sOut & "SFGAO_HASSUBFOLDER,"
If (atr And SFGAO_HIDDEN) = SFGAO_HIDDEN Then sOut = sOut & "SFGAO_HIDDEN,"
If (atr And SFGAO_ISSLOW) = SFGAO_ISSLOW Then sOut = sOut & "SFGAO_ISSLOW,"
If (atr And SFGAO_LINK) = SFGAO_LINK Then sOut = sOut & "SFGAO_LINK,"
If (atr And SFGAO_NEWCONTENT) = SFGAO_NEWCONTENT Then sOut = sOut & "SFGAO_NEWCONTENT,"
If (atr And SFGAO_NONENUMERATED) = SFGAO_NONENUMERATED Then sOut = sOut & "SFGAO_NONENUMERATED,"
If (atr And SFGAO_READONLY) = SFGAO_READONLY Then sOut = sOut & "SFGAO_READONLY,"
If (atr And SFGAO_REMOVABLE) = SFGAO_REMOVABLE Then sOut = sOut & "SFGAO_REMOVABLE,"
If (atr And SFGAO_SHARE) = SFGAO_SHARE Then sOut = sOut & "SFGAO_SHARE,"
If (atr And SFGAO_STORAGE) = SFGAO_STORAGE Then sOut = sOut & "SFGAO_STORAGE,"
If (atr And SFGAO_STORAGEANCESTOR) = SFGAO_STORAGEANCESTOR Then sOut = sOut & "SFGAO_STORAGEANCESTOR,"
If (atr And SFGAO_STREAM) = SFGAO_STREAM Then sOut = sOut & "SFGAO_STREAM,"
If (atr And SFGAO_SYSTEM) = SFGAO_SYSTEM Then sOut = sOut & "SFGAO_SYSTEM,"
If (atr And SFGAO_VALIDATE) = SFGAO_VALIDATE Then sOut = sOut & "SFGAO_VALIDATE,"
dbg_sfgao_tostring = sOut
End Function

Private Function PathGetDisp(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
    sPath = Left$(sPath, Len(sPath) - 1)
End If
Dim psi As IShellItem
Dim lp As LongPtr
If (sPath = "0") And (mComputerAsRoot = False) Then
    sPath = sDesktopPath
End If
If (sPath = "1") Then
    sPath = sFavPath
End If
Call SHCreateItemFromParsingName(StrPtr(sPath), Nothing, IID_IShellItem, psi)
If (psi Is Nothing) = False Then
    psi.GetDisplayName SIGDN_NORMALDISPLAY, lp
    PathGetDisp = LPWSTRtoStr(lp)
End If
End Function

Private Function GetLinkTarget(siLink As IShellItem) As String
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim isl As IShellLinkW
Dim sTmp As String
Dim wfd As WIN32_FIND_DATAW
siLink.BindToHandler 0&, BHID_SFUIObject, IID_IShellLinkW, isl
If (isl Is Nothing) = False Then
    sTmp = String$(MAX_PATH, 0)
    isl.GetPath StrPtr(sTmp), MAX_PATH, wfd, 0&
    sTmp = TrimNullW(sTmp)
'    If sTmp = "" Then
'        Dim pidl As Long
'        pidl = isl.GetIDList
'
    GetLinkTarget = sTmp
End If
 
'<EhFooter>
Exit Function

e0:
    DebugAppend "ucShellTree.GetLinkTarget->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Function

Private Function GetLinkTargetPIDL(siLink As IShellItem) As LongPtr
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim isl As IShellLinkW
Dim sTmp As String
Dim wfd As WIN32_FIND_DATAW
siLink.BindToHandler 0&, BHID_SFUIObject, IID_IShellLinkW, isl
If (isl Is Nothing) = False Then
    GetLinkTargetPIDL = isl.GetIDList()
End If
 
'<EhFooter>
Exit Function

e0:
    DebugAppend "ucShellTree.GetLinkTargetPIDL->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Function

Private Function LibGetDefLoc2(szPath As String) As String
'if current path is a library, get its default save location to drop there
Dim siLib As IShellItem
Dim siItem As IShellItem
Dim lpPath As LongPtr
Dim pSL As IShellLibrary
Set pSL = New ShellLibrary

SHCreateItemFromParsingName StrPtr(szPath), Nothing, IID_IShellItem, siLib

If (siLib Is Nothing) = False Then
    pSL.LoadLibraryFromItem siLib, STGM_READ
    pSL.GetDefaultSaveFolder DSFT_DETECT, IID_IShellItem, siItem
    If (siItem Is Nothing) = False Then
        siItem.GetDisplayName SIGDN_FILESYSPATH, lpPath
        LibGetDefLoc2 = LPWSTRtoStr(lpPath)
        siItem.GetDisplayName SIGDN_NORMALDISPLAY, lpPath
        mDragOver = LPWSTRtoStr(lpPath)
        Set siItem = Nothing
    End If
    
    Set pSL = Nothing
    Set siLib = Nothing
End If

End Function

Private Function InvokeVerb(pcm As IContextMenu, ByVal pszVerb As String, Optional lFlags As InvokeCommandMask = 0&) As Long
    '<EhHeader>
    On Error GoTo InvokeVerb_Err
    '</EhHeader>

Dim hMenu As LongPtr
Dim tCmdInfo As CMINVOKECOMMANDINFO
Dim tCmdInfoEx As CMINVOKECOMMANDINFOEX
hMenu = CreatePopupMenu()
Dim sVerb As String
Dim pcm2 As IContextMenu2
sVerb = pszVerb
Dim lpCmd As Long
Dim PT As POINT
Dim nItems As Long
Dim sDesc As String
Dim i As Long
Dim bGo As Boolean
lpCmd = -1
If hMenu Then
'    Set pcm2 = pcm
    If (pcm Is Nothing) = False Then
'        DebugAppend "Got pcm"
        pcm.QueryContextMenu hMenu, 0&, 1&, &H7FFF, CMF_EXPLORE Or CMF_OPTIMIZEFORINVOKE
        nItems = GetMenuItemCount(hMenu)
        DebugAppend "InvokeVerb nItems=" & nItems
        For i = 0 To nItems - 1
            lpCmd = GetMenuItemID(hMenu, i)
'            DebugAppend "i=" & i & ", lpCmd=" & lpCmd
            If lpCmd <= 0 Then GoTo nxt
            On Error Resume Next
            sVerb = String$(MAX_PATH, 0&)
            pcm.GetCommandString lpCmd - 1, GCS_VERBW, 0&, StrPtr(sVerb), Len(sVerb)
            On Error GoTo InvokeVerb_Err
            If (Err.Number = 0&) Then
                sVerb = TrimNullW(sVerb)
                DebugAppend "CmdStr=" & sVerb
'                DebugAppend "InvokeVerb hMenu=" & hMenu
                On Error Resume Next
                sDesc = String$(MAX_PATH, 0&)
                pcm.GetCommandString lpCmd - 1, GCS_HELPTEXTW, 0&, StrPtr(sDesc), Len(sDesc)
                sDesc = TrimNullW(sDesc)
                On Error GoTo InvokeVerb_Err
'                DebugAppend "HelpStr=" & sDesc
                If LCase$(sVerb) = LCase$(pszVerb) Then
                    DebugAppend "InvokeVerb go on " & sVerb
                    bGo = True
                    Exit For
                End If
            Else
                DebugAppend "InvokeVerb.GetCommandString Error::" & Err.Description
                Err.Clear
            End If
nxt:
        Next i
        If bGo Then
            tCmdInfo.cbSize = LenB(tCmdInfo)
            tCmdInfo.hwnd = hTVD
            tCmdInfo.lpVerb = lpCmd - 1&
            tCmdInfo.fMask = lFlags
            tCmdInfo.nShow = SW_SHOWNORMAL
            pcm.InvokeCommand VarPtr(tCmdInfo)
            DebugAppend "command invoked"
        End If
        Call DestroyMenu(hMenu)
    End If
End If

 '<EhFooter>
 Exit Function

InvokeVerb_Err:
    DebugAppend "InvokeVerb->" & Err.Description & " (" & Err.Number & ")"
 '</EhFooter>
End Function

Private Sub UpdateStatus(sText As String)
RaiseEvent StatusMessage(sText)
End Sub

Private Sub TVDragHover(X As Long, Y As Long, lKeyState As Long)
Dim tvhti As TVHITTESTINFO
Dim ppt As POINT
ppt.x = X
ppt.y = Y
Call ScreenToClient(hTVD, ppt)
tvhti.PT.x = ppt.x
tvhti.PT.y = ppt.y
TreeView_HitTest hTVD, tvhti
If (tvhti.Flags And TVHT_ONITEM) Then
    DebugAppend "DragHover " & X & "," & Y & ",hItem=" & GetTVItemText(hTVD, tvhti.hItem)
    TreeView_Expand hTVD, tvhti.hItem, TVE_EXPAND
End If

End Sub

Private Sub TVQueryDragOverData(in_ItemIndex As LongPtr, in_fIsGroup As Boolean, out_FullPath As String, out_Invalid As Boolean)
out_FullPath = GetTVItemPath(hTVD, in_ItemIndex)
If out_FullPath = "0" Then
    If (mComputerAsRoot = False) Then
        out_FullPath = sDesktopPath
    End If
End If
If out_FullPath = "1" Then
    out_FullPath = sFavPath
End If
If out_FullPath = "" Then
    out_Invalid = True
Else
    out_Invalid = False
End If

End Sub

Private Sub TVQueryDragOverItem(in_ptX As Long, in_ptY As Long, in_PrevIndex As LongPtr, out_NewIndex As LongPtr, out_fGroup As Boolean, out_fValid As Long, out_fFolder As Long)
Dim PT As POINT
PT.x = in_ptX
PT.y = in_ptY
out_NewIndex = TVDragOver(hTVD, PT, in_PrevIndex, out_fValid, out_fFolder)
If out_NewIndex <> in_PrevIndex Then
    DebugAppend "TVQueryDragOverItem found new item, " & in_PrevIndex & " != " & out_NewIndex & "; fldr=" & out_fFolder
End If
End Sub

Private Sub SetPreferredEffect(ido As IDataObject, nVal As Long)
Dim fmt As FORMATETC
Dim sTg As STGMEDIUM
Dim tDD As DROPDESCRIPTION
Dim hGlobal As LongPtr, lpGlobal As LongPtr
Dim i As Long
'Dim cfstr As String
'cfstr = "Preferred DropEffect"
DebugAppend "adddil.enter"

hGlobal = GlobalAlloc(GHND, LenB(nVal))
If hGlobal Then
    lpGlobal = GlobalLock(hGlobal)
    Call CopyMemory(ByVal lpGlobal, nVal, LenB(nVal))
    DebugAppend "adddil.copymem"
    Call GlobalUnlock(hGlobal)
    sTg.tymed = TYMED_HGLOBAL
    sTg.data = lpGlobal
    fmt.cfFormat = CF_PREFERREDDROPEFFECT
    fmt.dwAspect = DVASPECT_CONTENT
    fmt.lIndex = -1
    fmt.tymed = TYMED_HGLOBAL
    ido.SetData fmt, sTg, 1
Else
    DebugAppend "failed to get hglobal"
End If
End Sub

Private Function GetPIDLFromFolderID(hOwner As LongPtr, _
                                                             nFolder As CSIDLs) As LongPtr
  Dim pidl As LongPtr
  Call SHGetFolderLocation(hOwner, nFolder, 0, 0, pidl)
    GetPIDLFromFolderID = pidl
  
End Function

Private Function StrGetPath(ByVal sFull As String) As String
'Gets a file path
Dim sOut As String
sOut = sFull
If InStrRev(sOut, "\") = 1 Then
    sFull = Left$(sOut, Len(sOut) - 1)
End If
If InStr(sFull, "\") = 0 Then
    StrGetPath = sFull 'usually happens for C:\ top level
    Exit Function
End If
StrGetPath = Left$(sOut, InStrRev(sOut, "\") - 1)
If Right$(StrGetPath, 1) = ":" Then
    StrGetPath = StrGetPath & "\" 'write C:\ instead of C:
End If
End Function

Private Function AddDropDescription(ido As IDataObject, nType As DROPIMAGETYPE, sMsg As String, sIns As String) As Boolean
'If bFlagBlockDD Then Exit Function
If (ido Is Nothing) Then
    DebugAppend "AddDropDescription::No data object, aborting"
    Exit Function
End If
Dim fmt As FORMATETC
Dim sTg As STGMEDIUM
Dim tDD As DROPDESCRIPTION
Dim iTmp1() As Integer
Dim iTmp2() As Integer
Dim hGlobal As LongPtr, lpGlobal As LongPtr
Dim i As Long
On Error GoTo e0
AddDropDescription = True
DebugAppend "cDropTarget.AddDropDescription.Entry" ', 9
Str2WCHAR sMsg, iTmp1
Str2WCHAR sIns, iTmp2

For i = 0 To UBound(iTmp1)
    tDD.szMessage(i) = iTmp1(i)
Next i

For i = 0 To UBound(iTmp2)
    tDD.szInsert(i) = iTmp2(i)
Next i
tDD.type = nType

hGlobal = GlobalAlloc(GHND, LenB(tDD))
If hGlobal Then
    lpGlobal = GlobalLock(hGlobal)
    Call CopyMemory(ByVal lpGlobal, tDD, LenB(tDD))
    Call GlobalUnlock(hGlobal)
    
    sTg.tymed = TYMED_HGLOBAL
    sTg.data = lpGlobal
    
    fmt.cfFormat = CF_DROPDESCRIPTION
    fmt.dwAspect = DVASPECT_CONTENT
    fmt.lIndex = -1
    fmt.tymed = TYMED_HGLOBAL
        
    ido.SetData fmt, sTg, 1
End If
Exit Function
e0:
    DebugAppend "AddDropDescription->" & Err.Description & " (" & Err.Number & ")"
    AddDropDescription = False
End Function

Private Sub Str2WCHAR(sz As String, iOut() As Integer)
Dim i As Long
ReDim iOut(255)
'If Len(sz) > MAX_PATH Then sz = Left$(sz, MAX_PATH)
For i = 1 To Len(sz)
    iOut(i - 1) = AscW(Mid$(sz, i, 1))
Next i

End Sub

Public Sub ResetTreeView()
'Removes all items and inserts from root
If Ambient.UserMode Then
    EmptyTreeView hTVD, True
    fRefreshing = 1
    bFilling = True
    EnumRoot
    bFilling = False
    fRefreshing = 0
End If
End Sub

Public Sub HardResetTreeView()
'Removes all items and inserts from root
If Ambient.UserMode Then
   DestroyWindow hTVD
   pvCreate
End If
End Sub

Public Sub RefreshTreeView()
'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
    ResetTreeView
    
    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

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

Public Sub FontSetByHFONT(hFont As Long)

End Sub
Private Sub SetNavWav()
Dim lp As LongPtr, sz As String
Dim kfm As New KnownFolderManager
Dim kfwin As IKnownFolder
kfm.GetFolder FOLDERID_Windows, kfwin
If (kfwin Is Nothing) = False Then
    kfwin.GetPath KF_FLAG_DEFAULT, lp
    sz = LPWSTRtoStr(lp)
    
    szNavWav = AddBackslash(sz) & "Media\Windows Navigation Start.wav"
End If

End Sub

Private Sub PlayNavSound()
If mNavSound = False Then Exit Sub
If szNavWav = "" Then SetNavWav
PlaySound StrPtr(szNavWav), 0&, SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
DebugAppend "PlayNavSound " & szNavWav

End Sub


Private Sub dbg_checkstyle()
DebugAppend "dbg_checkstyle"
Dim dwStyle As ucst_TV_Styles
dwStyle = CLng(GetWindowLong(hTVD, GWL_STYLE))
If (dwStyle Or TVS_DISABLEDRAGDROP) = TVS_DISABLEDRAGDROP Then
    DebugAppend "DragDrop disabled"
Else
    DebugAppend "No dd flag found, " & (dwStyle Or TVS_DISABLEDRAGDROP)
End If
End Sub

Private Function TVItemGetDispColor(lp As LongPtr) As Long
'Compressed = blue, encrypted = green
If (mNameColors = False) Then
    OleTranslateColor clrFore, 0&, TVItemGetDispColor
 ' m_SysClrText
    Exit Function
End If
'DebugAppend "QueryColor " & TVEntries(lp).sName

If (TVEntries(lp).dwAttrib And SFGAO_COMPRESSED) = SFGAO_COMPRESSED Then
    TVItemGetDispColor = vbBlue
    Exit Function
End If
If (TVEntries(lp).dwAttrib And SFGAO_ENCRYPTED) = SFGAO_ENCRYPTED Then
    TVItemGetDispColor = &HD9213
    Exit Function
End If
OleTranslateColor clrFore, 0&, TVItemGetDispColor
End Function

Private Sub DoPaths(hItem As LongPtr)
'add checked folders to the path list
Dim tVI As TVITEM
Dim uState As Long
Dim hItemChild As LongPtr
Dim sPath As String
Dim nIdx As Long
nItr = nItr + 1
If nItr > 10000 Then Exit Sub


If hItem = 0 Then hItem = TreeView_GetRoot(hTVD)

Do While hItem
    tVI.hItem = hItem
    tVI.Mask = TVIF_CHILDREN Or TVIF_STATE Or TVIF_PARAM
    tVI.StateMask = TVIS_STATEIMAGEMASK
    TreeView_GetItem hTVD, tVI
    
    sPath = TVEntries(tVI.lParam).sFullPath
    DebugAppend "hitem=" & hItem & ",path=" & sPath
    If (tVI.Mask) And TVIS_STATEIMAGEMASK = &H2000 Then 'check item; add it
        ReDim Preserve gPaths(nPaths)
        gPaths(nPaths) = sPath 'GetFolderDisplayName(tvid.isfParent, tvid.pidlRel, SHGDN_INFOLDER) '
        nPaths = nPaths + 1
    Else
        If tVI.cChildren > 0 Then
            hItemChild = TreeView_GetNextItem(hTVD, hItem, TVGN_CHILD)
            DoPaths hItemChild
        End If
    End If
    
    hItem = TreeView_GetNextItem(hTVD, hItem, TVGN_NEXT)
Loop
End Sub

Private Sub EnumPaths(hwnd As LongPtr, ByVal hItem As LongPtr)
'DebugAppend "EnumPaths.Entry"
Dim tVI As TVITEM
Dim hItemChild As LongPtr
Dim aTmp() As String
Dim i As Long
Dim nIdx As Long
Dim sPath As String
    Do While hItem
        tVI.hItem = hItem
        tVI.Mask = TVIF_CHILDREN Or TVIF_STATE Or TVIF_HANDLE
        tVI.StateMask = TVIS_STATEIMAGEMASK 'TVIS_BOLD
        TreeView_GetItem hTVD, tVI

        If (tVI.State And TVIS_STATEIMAGEMASK) = &H2000 Then 'TVIS_BOLD Then
            DebugAppend "checked item found, " & GetTVItemText(hwnd, hItem) & "-" & hItem
            
            If TVEntries(tVI.lParam).sFullPath <> "" Then 'merge into main results
                    DebugAppend "Add checked path " & TVEntries(tVI.lParam).sFullPath
                    ReDim Preserve gPaths(nPaths)
                    gPaths(nPaths) = TVEntries(tVI.lParam).sFullPath
                    nPaths = nPaths + 1
            End If
        Else
        hItemChild = TreeView_GetChild(hTVD, tVI.hItem)
        Call EnumPaths(hwnd, hItemChild)
        End If
        
        hItem = TreeView_GetNextSibling(hTVD, hItem)
    Loop
End Sub

Private Function GetNodeByPath(sFullPath As String, Optional bStripComp As Boolean = False) As LongPtr
Dim i As Long
Dim sNoCmp As String
For i = 0 To UBound(TVEntries)
    sNoCmp = TVEntries(i).sFullPath
    If bStripComp Then
        If InStr(sNoCmp, sComp & "\") Then
            sNoCmp = Mid$(sNoCmp, Len(sComp & "\") + 1)
        End If
    End If
    If sNoCmp = sFullPath Then
        GetNodeByPath = TVEntries(i).hNode
        Exit Function
    End If
Next i
GetNodeByPath = -1
End Function

Private Sub CreateCurrentMap()
Dim hRoot As LongPtr
hRoot = TreeView_GetRoot(hTVD)

ReDim TVVisMap(0)
TVVisMap(0) = TVEntries(0) 'copy desktop
nTVVis = 1
MapVisibleItems hTVD, hRoot
End Sub

Private Sub MapVisibleItems(hwnd As LongPtr, hItem As LongPtr)
Dim tVI As TVITEM
Dim tviPar As TVITEM
Dim hItemPar As LongPtr
Dim hItemChild As LongPtr
Dim hParLast As LongPtr
Dim bRunCheck As Boolean
Dim lCR As Long
Dim aTmp() As String
Dim i As Long
Dim nIdx As Long
Dim sPath As String
    Do While hItem
        tVI.hItem = hItem
        tVI.Mask = TVIF_CHILDREN Or TVIF_STATE Or TVIF_HANDLE Or TVIF_PARAM
        tVI.StateMask = TVIS_STATEIMAGEMASK Or TVIS_EXPANDED 'TVIS_BOLD
        TreeView_GetItem hTVD, tVI
'        If (tvi.State And TVIS_EXPANDED) = TVIS_EXPANDED Then 'TVIS_BOLD Then
        If True Then
            hItemPar = TreeView_GetParent(hTVD, tVI.hItem)
            If hItemPar Then
                tviPar.hItem = hItemPar
                tviPar.Mask = TVIF_STATE Or TVIF_HANDLE Or TVIF_PARAM
                tviPar.StateMask = TVIS_EXPANDED
                TreeView_GetItem hTVD, tviPar
                If (tviPar.State And TVIS_EXPANDED) = TVIS_EXPANDED Then
                    If hItemPar <> hParLast Then
                        lCR = TVCheckExpand(hItemPar)
                    End If
                    If lCR = S_OK Then 'Check all higher level parents to make sure they're expanded too
'                    DebugAppend "Found visible item, " & GetTVItemText(hwnd, hItem) & "/" & TVEntries(tvi.lParam).sFullPath
                    ReDim Preserve TVVisMap(nTVVis)
                    TVVisMap(nTVVis) = TVEntries(tVI.lParam)
                    nTVVis = nTVVis + 1
                    End If
                End If
            End If
        hItemChild = TreeView_GetChild(hTVD, tVI.hItem)
        Call MapVisibleItems(hwnd, hItemChild)
        Else
        End If
                    hParLast = hItemPar
        
        hItem = TreeView_GetNextSibling(hTVD, hItem)
    Loop
End Sub

Private Function TVCheckExpand(hNode As LongPtr) As Long
Dim tVI As TVITEM
Dim tviPar As TVITEM
Dim hItemPar As LongPtr
Dim hItemChild As LongPtr
'If hNode = m_hRoot Then
    hItemPar = hNode
'Else
'    hItemPar = TreeView_GetParent(hTVD, tVI.hItem)
'End If
    Do While hItemPar
'        DebugAppend "TVCheckExpand::Checking " & GetTVItemText(hTVD, hItemPar)
        tviPar.hItem = hItemPar
        tviPar.Mask = TVIF_STATE Or TVIF_HANDLE Or TVIF_PARAM
        tviPar.StateMask = TVIS_EXPANDED
        TreeView_GetItem hTVD, tviPar
        If (tviPar.State And TVIS_EXPANDED) = 0& Then
''            DebugAppend "TVCheckExpand::Unexpanded Parent->" & GetTVItemText(hTVD, hItemPar)
            TVCheckExpand = 1&
            Exit Function
        Else
'            DebugAppend "TVCheckExpand::Expanded Parent->" & GetTVItemText(hTVD, hItemPar)
        
        End If
        hItemPar = TreeView_GetParent(hTVD, hItemPar)
    Loop
        
End Function

Private Function IsUSBDevice(sParse As String) As Boolean
If Left$(sParse, 49) = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#" Then
    IsUSBDevice = True
End If
End Function

Private Function ParseUSBDevice(sFull As String) As String
Dim s1 As String
Dim s2 As String
Dim n1 As Long
s1 = sFull
s1 = Mid$(s1, InStr(s1, "\\\?\usb#") + 1)

n1 = InStr(6, s1, "\")
If n1 = 0 Then
    ParseUSBDevice = s1
Else
    s2 = Left$(s1, n1 - 1)
    ParseUSBDevice = s2
End If
End Function

Private Function USBDeviceEnsureAdded(sDev As String) As LongPtr
Dim hComp As LongPtr
Dim sUSB As String
sUSB = ParseUSBDevice(sDev)
Dim hDev As LongPtr
hDev = GetNodeByPath(sUSB, True)
DebugAppend "hDev=" & hDev
If hDev <> -1 Then
    DebugAppend "USBDeviceEnsureAdded::Device already added."
    USBDeviceEnsureAdded = hDev
    Exit Function
End If

hComp = GetNodeByPath(sComp)
If hComp Then
    Dim si As IShellItem
    SHCreateItemFromParsingName StrPtr(sComp & "\" & sUSB), Nothing, IID_IShellItem, si
    If (si Is Nothing) = False Then
        DebugAppend "USBDeviceEnsureAdded::Got device item, adding..."
        TVAddItem si, hComp
        If InStr(TVEntries(UBound(TVEntries)).sFullPath, "\\?\usb#") Then
            USBDeviceEnsureAdded = TVEntries(UBound(TVEntries)).hNode
            Exit Function
        End If
    End If
End If
USBDeviceEnsureAdded = -1
End Function

Private Sub pSetRedrawMode(ByVal Enable As Boolean)
   If (hTVD) Then
      Call SendMessage(hTVD, WM_SETREDRAW, -Enable, ByVal 0&)
   End If
End Sub

Public Sub OpenToPath(sFullPath As String, bExpandTarget As Boolean, Optional bSelectTarget As Boolean = True)
'OpenToItem by path instead of shell item
If sFullPath = mCustomRoot Then Exit Sub
If sFullPath = sSelectedItem Then Exit Sub
Dim psi As IShellItem
SHCreateItemFromParsingName StrPtr(sFullPath), Nothing, IID_IShellItem, psi
If (psi Is Nothing) = False Then
     OpenToItem psi, bExpandTarget, bSelectTarget
 End If
End Sub

Public Sub OpenToItem(si As IShellItem, bExpandTarget As Boolean, Optional bSelectTarget As Boolean = True)
If bLoadDone = False Then Exit Sub
Dim lpFull As LongPtr, sFull As String
si.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
sFull = LPWSTRtoStr(lpFull)
If sFull = mCustomRoot Then Exit Sub
If (sFull <> "") Then
    If sFull = sSelectedItem Then Exit Sub
End If
bNavigating = True
bFlagBlockClkExp = False
pSetRedrawMode False
Hourglass True
lLoopTrack = 0
DebugAppend "OpenToItem " & sFull
If IsUSBDevice(sFull) Then
    DebugAppend "OpenToItem->Detected USB device, ensuring add..."
    Dim hrua As LongPtr
    hrua = USBDeviceEnsureAdded(sFull)
    DebugAppend "OpenToItem->EnsureAdd result=" & hrua
End If
DebugAppend bExpandTarget
TVNavigate si, bExpandTarget, bSelectTarget
Hourglass False
pSetRedrawMode True
bNavigating = False
End Sub

Public Sub SelectedNodeExpand()
Dim hNode As LongPtr
hNode = SendMessage(hTVD, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
If hNode Then
    Call SendMessage(hTVD, TVM_EXPAND, ByVal TVE_EXPAND, ByVal hNode)
End If
End Sub
Public Sub SelectedNodeCollapse()
Dim hNode As LongPtr
hNode = SendMessage(hTVD, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
If hNode Then
    Call SendMessage(hTVD, TVM_EXPAND, ByVal TVE_COLLAPSE, ByVal hNode)
End If
End Sub
Public Sub SelectedNodeToggle()
Dim hNode As LongPtr
hNode = SendMessage(hTVD, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
If hNode Then
    Call SendMessage(hTVD, TVM_EXPAND, ByVal TVE_TOGGLE, ByVal hNode)
End If
End Sub

Public Sub SelectedNodesExpand()
Dim hItemSel As LongPtr
Do
    hItemSel = SendMessage(hWnd, TVM_GETNEXTITEM, TVGN_NEXTSELECTED, ByVal hItemSel)
    If hItemSel Then
        Call SendMessage(hTVD, TVM_EXPAND, ByVal TVE_EXPAND, ByVal hItemSel)
    End If
Loop While hItemSel
End Sub
Public Sub SelectedNodesCollapse()
Dim hItemSel As LongPtr
Do
    hItemSel = SendMessage(hWnd, TVM_GETNEXTITEM, TVGN_NEXTSELECTED, ByVal hItemSel)
    If hItemSel Then
        Call SendMessage(hTVD, TVM_EXPAND, ByVal TVE_COLLAPSE, ByVal hItemSel)
    End If
Loop While hItemSel
End Sub
Public Sub SelectedNodesToggle()
Dim hItemSel As LongPtr
Do
    hItemSel = SendMessage(hWnd, TVM_GETNEXTITEM, TVGN_NEXTSELECTED, ByVal hItemSel)
    If hItemSel Then
        Call SendMessage(hTVD, TVM_EXPAND, ByVal TVE_TOGGLE, ByVal hItemSel)
    End If
Loop While hItemSel
End Sub

Private Sub TVNavigate(si As IShellItem, bExpandTarget As Boolean, bSelectTarget As Boolean)
Dim i As Long
Dim bFlag As Boolean
Dim lp As Long
Dim lpFull As LongPtr, sFull As String
Dim lAtr As SFGAOF
Dim hPar As LongPtr
Dim siPar As IShellItem, siPar2 As IShellItem
Dim idx As Long
Dim bPaged As Boolean
Dim hAdd As LongPtr

If lLoopTrack > 100 Then
    DebugAppend "Error: Infinite loop detected."
    Exit Sub
End If
lLoopTrack = lLoopTrack + 1
si.GetAttributes SFGAO_FOLDER Or SFGAO_STREAM, lAtr
If (mShowFiles = False) And ((lAtr And SFGAO_FOLDER) = 0&) Then Exit Sub 'it's not a folder, so exit if we're not showing files too
If (mExpandZip = False) And ((lAtr And SFGAO_STREAM) = SFGAO_STREAM) Then Exit Sub 'Zip files only shown if mExpandZip=True

DebugAppend "TVNavigate->CreateCurrentMap"
CreateCurrentMap   'Map the visible items (the main entry list contains items in collapsed folders)

si.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
sFull = LPWSTRtoStr(lpFull)
DebugAppend "TVNavigate " & sFull & ", " & bExpandTarget
'First, check to see if it's already present
DebugAppend "TVNavigate->GetIdxByPath"
idx = GetMapIdxByPath(sFull)
If idx > -1 Then
        DebugAppend "OpenToItem::Item already visible"
        If bFlagRecurseOI = False Then
            fNoExpand = 1
            If bSelectTarget Then
                TreeView_EnsureVisible hTVD, TVVisMap(idx).hNode
                TreeView_SelectItem hTVD, TVVisMap(idx).hNode
            End If
'            TreeView_Select hTVD, TVVisMap(idx).hNode, TVGN_DROPHILITE
            fNoExpand = 0
        End If
        If (TVVisMap(idx).bFolder) And (bExpandTarget = True) Then
            DebugAppend "OpenToItem::AlreadyVis->Expand"
            TreeView_Expand hTVD, TVVisMap(idx).hNode, TVE_EXPAND
        End If
        SetFocusAPI UserControl.ContainerHwnd
        SetFocusAPI hTVD
        Exit Sub
End If

If sFull = sUserDesktop Then
    SHGetKnownFolderItem FOLDERID_Profile, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siPar
Else
    si.GetParent siPar
End If
If (siPar Is Nothing) = False Then
    lpFull = 0: sFull = ""
    siPar.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
    sFull = LPWSTRtoStr(lpFull)
    DebugAppend "TVNavigate::FirstParent=" & sFull
    bPaged = False
    bPaged = IsPagedVirtualPath(sFull)
    If bPaged Then
        sFull = Left$(sFull, Len(sFull) - 2)
        DebugAppend "TVNavigate::Adjusted paged virtual item parent to " & sFull
    End If
    idx = GetMapIdxByPath(sFull)
    If idx > -1 Then
        DebugAppend "Found at first parent: " & TVVisMap(idx).sName & "," & TVVisMap(idx).sFullPath
        TreeView_Expand hTVD, TVVisMap(idx).hNode, TVE_EXPAND
        If Not bPaged Then
            TVNavigate si, bExpandTarget, bSelectTarget
        Else
            TVAddItem si, TVVisMap(idx).hNode, True
            hAdd = TVEntries(UBound(TVEntries)).hNode
            TreeView_EnsureVisible hTVD, hAdd
            TreeView_SelectItem hTVD, hAdd
        
        End If
        Exit Sub
    End If
Else
    UpdateStatus "Path not found."
    Exit Sub
End If

Dim siRm() As IShellItem
Dim rmct As Long
              
Dim nStartFrom As Long
Dim j As Long, k As Long
Dim sPrev As String
ReDim siRm(0)
Set siRm(0) = siPar
rmct = rmct + 1
Do
    ReDim Preserve siRm(rmct)
    If siRm(rmct - 1).GetParent(siRm(rmct)) = S_OK Then
        sPrev = sFull
        lpFull = 0: sFull = ""
        siRm(rmct).GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
        sFull = LPWSTRtoStr(lpFull)
        If (sFull = sUserDesktop) And (sPrev = sUserFolder) Then
            'Parent is \Users\ not desktop wtf!
            sFull = "C:\Users"
        End If
        DebugAppend "AddParent(" & rmct & ")=" & sFull
        idx = GetMapIdxByPath(sFull)
        If idx > -1 Then nStartFrom = rmct
        rmct = rmct + 1
    Else
        DebugAppend "Ran out of parents? Not found"
        UpdateStatus "Path not found."
        TVAddItem si, m_hRoot, True
        hAdd = TVEntries(UBound(TVEntries)).hNode
        TreeView_EnsureVisible hTVD, hAdd
        TreeView_SelectItem hTVD, hAdd

        Exit Do
    End If
Loop Until nStartFrom <> 0 'if it was 0 our first parent block would have succeeded

If nStartFrom Then
    DebugAppend "ParentStartIndex=" & nStartFrom
    TreeView_Expand hTVD, TVVisMap(idx).hNode, TVE_EXPAND
    bFlagRecurseOI = True
    For j = (nStartFrom - 1) To 0 Step -1
        TVNavigate siRm(j), True, bSelectTarget
    Next j
    bFlagRecurseOI = False
    TVNavigate si, bExpandTarget, bSelectTarget
End If

DebugAppend "TVNavigate.End"

End Sub

Private Function IsPagedVirtualPath(sPath As String) As Boolean
'Automatic navigation has problems with paths like ::GUID\n control panel items that can't actually be expanded to find the child
Dim i As Long, j As Long

If Left$(sPath, 3) = "::{" Then
    For i = 0 To 9
        If Right$(sPath, 2) = "\" & CStr(i) Then
            IsPagedVirtualPath = True
            Exit Function
        End If
   Next i
End If
   
End Function

Private Function GetMapIdxByPath(sFullPath As String) As Long
Dim i As Long
For i = 0 To UBound(TVVisMap)
    If (TVVisMap(i).bDeleted = False) And (TVVisMap(i).bFavorite = False) Then
        If LCase$(TVVisMap(i).sFullPath) = LCase$(sFullPath) Then
            GetMapIdxByPath = i
            Exit Function
        End If
    End If
Next i
GetMapIdxByPath = -1
End Function

Private Function GetTVSelectedItemPath() As String
'For single-select mode
Dim tVI As TVITEM
Dim hItem As LongPtr
Dim lp As LongPtr
Dim aTmp() As String
Dim lpsz As LongPtr
Dim lpAtr As SFGAOF
Dim nIdx As Long
On Error GoTo e0

hItem = TreeView_GetSelection(hTVD)
If hItem Then
    lp = GetTVItemlParam(hTVD, hItem)
    If lp Then
        GetTVSelectedItemPath = TVEntries(lp).sFullPath
    Else
        DebugAppend "mTreeView.GetTVSelectedItemPath.Error->Failed to get item lParam", 2
    End If
Else
    DebugAppend "mTreeView.GetTVSelectedItemPath.Warning->GetSelection did not return an hItem", 3
End If

Exit Function

e0:
DebugAppend "mTreeView.GetTVSelectedItemPath.Error->" & Err.Description & " (" & Err.Number & ")"

End Function

Private Sub TVUncheckAllChildren(hwnd As LongPtr, hItem As LongPtr)
'pass the first child item of the node
Dim hItemChild As LongPtr
Dim i As Long
    Do While hItem
'        SetTVItemStateImage hwnd, hItem, tvcsEmpty
        TreeView_SetCheckState hTVD, hItem, 0
        hItemChild = TreeView_GetChild(hTVD, hItem)
        Call TVUncheckAllChildren(hwnd, hItemChild)
        
        hItem = TreeView_GetNextSibling(hTVD, hItem)
    Loop
End Sub

Private Function TVItemIsZip(hwnd As LongPtr, lParam As LongPtr) As Boolean
Dim lAtr As SFGAOF

lAtr = SFGAO_STREAM 'it already has SFGAO_FOLDER by virtue of being in the list
Dim nIdx As Long
nIdx = GetIndexFromNode(lParam)
lAtr = TVEntries(lParam).dwAttrib
If (lAtr And SFGAO_STREAM) Then TVItemIsZip = True

End Function

Private Function TVNodeHasUncheckedChildren(hItem As LongPtr) As Boolean
Dim hChild As LongPtr
Dim tVI As TVITEM
Dim cst As Long

hChild = TreeView_GetChild(hTVD, hItem)
Do While hChild
    cst = TreeView_GetCheckState(hTVD, hChild)
    If (cst = 1) Or (cst >= 3) Then
        TVNodeHasUncheckedChildren = True
        Exit Function
    End If
    hChild = TreeView_GetNextSibling(hTVD, hChild)
Loop

End Function

Private Function TVNodeHasCheckedChildren(hItem As LongPtr) As Boolean
Dim hChild As LongPtr
Dim tVI As TVITEM
Dim cst As Long

hChild = TreeView_GetChild(hTVD, hItem)
Do While hChild
    cst = TreeView_GetCheckState(hTVD, hChild)
    If (cst = 2) Or (cst = 3) Then
        TVNodeHasCheckedChildren = True
        DebugAppend "Found checked child: " & GetTVItemText(hTVD, hChild)
        Exit Function
    End If
    hChild = TreeView_GetNextSibling(hTVD, hChild)
Loop

End Function

Private Function TVSetParentAfterCheck(hPar As LongPtr) As Long
DebugAppend "TVSetParentAfterCheck " & GetTVItemText(hTVD, hPar)
Dim hPar2 As LongPtr
Dim tVI As TVITEM
    If ((hPar > 0)) Then 'And (hPar <> m_hRoot)

hPar2 = hPar
'Do While ((hPar2 > 0) And (hPar2 <> m_hRoot))
    If TVNodeHasUncheckedChildren(hPar2) Then
        TreeView_SetCheckStateEx hTVD, hPar2, 3
    Else
        TreeView_SetCheckStateEx hTVD, hPar2, 2
    End If
    hPar2 = TreeView_GetParent(hTVD, hPar2)
    If ((hPar2 > 0)) Then ' And (hPar2 <> m_hRoot)) Then
        TVSetParentAfterCheck hPar2
    End If
End If
End Function

Private Function TVSetParentAfterUncheck(hPar As LongPtr) As Long
DebugAppend "TVSetParentAfterUncheck " & GetTVItemText(hTVD, hPar)
Dim hPar2 As LongPtr
Dim tVI As TVITEM
    If ((hPar > 0)) Then ' And (hPar <> m_hRoot)) Then

hPar2 = hPar
'Do While ((hPar2 > 0) And (hPar2 <> m_hRoot))
    If TVNodeHasCheckedChildren(hPar2) Then
        TreeView_SetCheckStateEx hTVD, hPar2, 3
    Else
        TreeView_SetCheckStateEx hTVD, hPar2, 1
    End If
    hPar2 = TreeView_GetParent(hTVD, hPar2)
    If ((hPar2 > 0)) Then ' And (hPar2 <> m_hRoot)) Then
        TVSetParentAfterUncheck hPar2
    End If
End If
End Function

Private Function TVUncheckChildren(hItem As LongPtr) As Long
DebugAppend "TVUnCheckChildren.Entry=" & GetTVItemText(hTVD, hItem)
Dim hChild As LongPtr
Dim hSib As LongPtr
Dim tVI As TVITEM

hSib = hItem
Do While hSib
    tVI.Mask = TVIF_CHILDREN Or TVIF_HANDLE Or TVIF_STATE
    tVI.hItem = hSib
    TreeView_GetItem hTVD, tVI
    
    TreeView_SetCheckState hTVD, hSib, 0
    If (tVI.cChildren) And ((tVI.State And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE) Then
        hChild = TreeView_GetChild(hTVD, hSib)
        TVCheckChildren hChild
    End If
    hSib = TreeView_GetNextSibling(hTVD, hSib)
Loop
End Function

Private Function TVCheckChildren(hItem As LongPtr) As Long
DebugAppend "TVCheckChildren.Entry=" & GetTVItemText(hTVD, hItem)
Dim hChild As LongPtr
Dim hSib As LongPtr
Dim tVI As TVITEM

hSib = hItem
Do While hSib
    tVI.Mask = TVIF_CHILDREN Or TVIF_HANDLE Or TVIF_STATE
    tVI.hItem = hSib
    TreeView_GetItem hTVD, tVI
    
    TreeView_SetCheckState hTVD, hSib, 1
    If (tVI.cChildren) And ((tVI.State And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE) Then
        hChild = TreeView_GetChild(hTVD, hSib)
        TVCheckChildren hChild
    End If
    hSib = TreeView_GetNextSibling(hTVD, hSib)
Loop

End Function

Private Function TVExcludeChildren(hItem As LongPtr) As Long
DebugAppend "TVCheckChildren.Entry=" & GetTVItemText(hTVD, hItem)
Dim hChild As LongPtr
Dim hSib As LongPtr
Dim tVI As TVITEM

hSib = hItem
Do While hSib
    tVI.Mask = TVIF_CHILDREN Or TVIF_HANDLE Or TVIF_STATE
    tVI.hItem = hSib
    TreeView_GetItem hTVD, tVI
    
    TreeView_SetCheckStateEx hTVD, hSib, 4
    If (tVI.cChildren) And ((tVI.State And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE) Then
        hChild = TreeView_GetChild(hTVD, hSib)
        TVCheckChildren hChild
    End If
    hSib = TreeView_GetNextSibling(hTVD, hSib)
Loop

End Function

Public Sub SelectNone()
Dim i As Long
ReDim sSelectedItems(0)
DebugAppend "SelectNone"
Dim hItemSel As LongPtr
Do
    hItemSel = 0
    hItemSel = TreeView_GetNextSelected(hTVD, hItemSel)
    If hItemSel Then
        TreeView_SetItemState hTVD, hItemSel, 0&, TVIS_SELECTED
    End If
Loop While hItemSel

End Sub

Private Sub SetMultiSel()
Dim nSel As Long
Dim apidl() As LongPtr, cpidl As Long
Dim aNm() As String
Dim lpSel As LongPtr
Dim i As Long
ReDim sSelectedItems(0): ReDim apidl(0)

DebugAppend "SetMultiSel"
Dim hItemSel As LongPtr
Do
    hItemSel = TreeView_GetNextSelected(hTVD, hItemSel)
    If hItemSel Then
        lpSel = GetTVItemlParam(hTVD, hItemSel)
        ReDim Preserve sSelectedItems(nSel)
        ReDim Preserve aNm(nSel)
        sSelectedItems(nSel) = TVEntries(lpSel).sFullPath
        aNm(nSel) = TVEntries(lpSel).sName
        nSel = nSel + 1
        ReDim Preserve apidl(cpidl)
        apidl(cpidl) = ILCombine(TVEntries(lpSel).pidlFQPar, TVEntries(lpSel).pidlRel)
        cpidl = cpidl + 1
    End If
Loop While hItemSel
If nSel > 0& Then
    Dim psia As IShellItemArray
    Dim iData As IDataObject
    SHCreateShellItemArrayFromIDLists cpidl, VarPtr(apidl(0)), siaSelected
End If
For i = 0 To UBound(apidl)
    If apidl(i) Then CoTaskMemFree apidl(i)
Next i

If (fLoad = 0&) Then RaiseEvent MultiSelectChange(siaSelected, aNm, sSelectedItems)

End Sub

Public Sub SelectedItems(sFullPaths() As String, siaItems As IShellItemArray)
SetMultiSel
sFullPaths = sSelectedItems
Set siaItems = siaSelected
End Sub

Private Function GetStrFromPtrA(lpszA As LongPtr) As String
  Dim sRtn As String
  sRtn = String$(lstrlenA(ByVal lpszA), 0)
  Call lstrcpyA(ByVal sRtn, ByVal lpszA)
  GetStrFromPtrA = sRtn
End Function

Private Sub ShowBalloonTipEx(hwnd As LongPtr, sTitle As String, sText As String, btIcon As ucst_BalloonTipIconConstants)
Dim lr As LongPtr
Dim tEBT As EDITBALLOONTIP
tEBT.cbStruct = LenB(tEBT)
tEBT.pszText = StrPtr(sText)
tEBT.pszTitle = StrPtr(sTitle)
tEBT.ttiIcon = btIcon
lr = SendMessageW(hwnd, EM_SHOWBALLOONTIP, 0, tEBT)
'DebugAppend "ShowBalloonTipEx=" & lR
End Sub

Private Function IsClipboardValidFileName() As Integer
Dim i As Long
Dim sz As String
Dim sChr As String

'sz = Clipboard.GetText
sz = GetClipboardTextW()
'dbg_stringbytes sz
IsClipboardValidFileName = 1

If sz = vbNullString Then
    DebugAppend "Clip is null"
    IsClipboardValidFileName = -1
End If
If Len(sz) > MAX_PATH Then IsClipboardValidFileName = -2

If InStr(sz, "*") Or InStr(sz, "<") Or InStr(sz, ">") Or InStr(sz, "|") Or InStr(sz, Chr$(34)) Or InStr(sz, Chr(&H3F)) Then
    IsClipboardValidFileName = -1
End If

DebugAppend "ClipCheck=" & IsClipboardValidFileName & "," & InStr(sz, "?")

End Function

Private Function GetClipboardTextW() As String
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim pdo As IDataObject
Dim tSTG As STGMEDIUM
Dim tFMT As FORMATETC
Dim lpGlobal As LongPtr
Dim hGlobal As LongPtr
Dim lpText As LongPtr
Dim stBuf As String

OleGetClipboard pdo
If (pdo Is Nothing) Then Exit Function

If DataObjSupportsFormat(pdo, CF_UNICODETEXT) Then
    'This should return True and successfully retrieve the text even if technically
    'the clipboard object actually only contains CF_TEXT.
    DebugAppend "DataObj Get CF_UNICODETEXT"
    
    tFMT.cfFormat = CF_UNICODETEXT
    tFMT.dwAspect = DVASPECT_CONTENT
    tFMT.lIndex = -1
    tFMT.tymed = TYMED_HGLOBAL

    pdo.GetData tFMT, tSTG
    lpText = GlobalLock(tSTG.data)
    GetClipboardTextW = LPWSTRtoStr(lpText, False)
    Call GlobalUnlock(tSTG.data)
    ReleaseStgMedium tSTG
ElseIf DataObjSupportsFormat(pdo, CF_TEXT) Then 'if there's no unicode chars there might be this only
    tFMT.cfFormat = CF_TEXT
    tFMT.dwAspect = DVASPECT_CONTENT
    tFMT.lIndex = -1
    tFMT.tymed = TYMED_HGLOBAL

    pdo.GetData tFMT, tSTG
    lpText = GlobalLock(tSTG.data)
    GetClipboardTextW = GetStrFromPtrA(lpText)
    DebugAppend "GetClipboardText ANSI fallback=" & GetClipboardTextW
End If
'<EhFooter>
Exit Function

e0:
    DebugAppend "ucShellBrowse.GetClipboardTextW->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Function

Private Function VerifyDropTarget(lIdx As LongPtr) As Long
Dim dt As IDropTarget
Dim si As IShellItem
Dim tVI As TVITEM
Dim de As DROPEFFECTS
Dim ppidlp As LongPtr
On Error GoTo e0

tVI.hItem = lIdx
tVI.Mask = TVIF_HANDLE Or TVIF_PARAM
TreeView_GetItem hTVD, tVI

If tVI.lParam Then
    If TVEntries(tVI.lParam).sFullPath = "1" Then
        If bQkAc Then
            SHCreateItemFromParsingName StrPtr(sQuickAccess), Nothing, IID_IShellItem, si
        Else
            SHGetKnownFolderItem FOLDERID_Links, KF_FLAG_DEFAULT, 0&, IID_IShellItem, si
        End If
    Else
        SHCreateItemFromParsingName StrPtr(TVEntries(tVI.lParam).sFullPath), Nothing, IID_IShellItem, si
        If (si Is Nothing) Then
            DebugAppend "VerifyDropTarget->ShellItem failed, trying to load from pidls...", 3
            If (TVEntries(tVI.lParam).pidlFQPar <> 0&) And (TVEntries(tVI.lParam).pidlRel <> 0&) Then
                ppidlp = ILCombine(TVEntries(tVI.lParam).pidlFQPar, TVEntries(tVI.lParam).pidlRel)
                SHCreateItemFromIDList ppidlp, IID_IShellItem, si
                If (si Is Nothing) = False Then
                    DebugAppend "VerifyDropTarget->LoadFromPidl->Success!", 3
                Else
                    DebugAppend "VerifyDropTarget->LoadFromPidl->Failed.", 3
                End If
            Else
                DebugAppend "VerifyDropTarget->LoadFromPidl->Parent or child pidl not set.", 3
            End If
        End If
    End If
    If (si Is Nothing) = False Then
        si.BindToHandler 0&, BHID_SFUIObject, IID_IDropTarget, dt
        If (dt Is Nothing) = False Then
            VerifyDropTarget = 1
            de = DROPEFFECT_MOVE Or DROPEFFECT_COPY Or DROPEFFECT_LINK
            Dim pt0 As POINT
            dt.DragEnter mDataObj, 0&, pt0, de
            dt.DragOver MK_LBUTTON, pt0, de
            If TVEntries(tVI.lParam).bLinkIsFolder Then
                VerifyDropTarget = 2
                GoTo out
            End If
            If de = DROPEFFECT_LINK Then
                VerifyDropTarget = 3
            End If
        End If
    End If
End If
out:
If ppidlp Then CoTaskMemFree ppidlp
Exit Function
e0:
    VerifyDropTarget = 0
End Function

Public Function DateToSystemTime(dt As Date) As SYSTEMTIME
DateToSystemTime.wDay = CInt(Day(dt))
DateToSystemTime.wMonth = CInt(Month(dt))
DateToSystemTime.wYear = CInt(Year(dt))
DateToSystemTime.wHour = CInt(Hour(dt))
DateToSystemTime.wMinute = CInt(Minute(dt))
DateToSystemTime.wSecond = CInt(Second(dt))

End Function
Private Function PKEY_Size() As PROPERTYKEY
Static pkk As PROPERTYKEY
 If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &HB725F130, &H47EF, &H101A, &HA5, &HF1, &H2, &H60, &H8C, &H9E, &HEB, &HAC, 12)
PKEY_Size = pkk
End Function
Private Function PKEY_DateModified() As PROPERTYKEY
Static pkk As PROPERTYKEY
 If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &HB725F130, &H47EF, &H101A, &HA5, &HF1, &H2, &H60, &H8C, &H9E, &HEB, &HAC, 14)
PKEY_DateModified = pkk
End Function

Private Function TVDragOver(hwnd As LongPtr, ppt As POINT, lPrevItem As LongPtr, fValid As Long, fFolder As Long) As LongPtr
Dim tvhti As TVHITTESTINFO

Call ScreenToClient(hwnd, ppt)
tvhti.PT.x = ppt.x
tvhti.PT.y = ppt.y

TreeView_HitTest hwnd, tvhti

If (tvhti.Flags And TVHT_ONITEMLINE) Then
    Dim lp As LongPtr
    lp = GetTVItemlParam(hwnd, tvhti.hItem)
    If tvhti.hItem <> lPrevItem Then
            DebugAppend "sel new item, prev=" & lPrevItem & ",cur=" & tvhti.hItem & " item=" & TVEntries(lp).sName & ",dt=" & TVEntries(lp).bDropTarget
            If TVEntries(lp).bDropTarget Then
'                TreeView_SelectItem hwnd, tvhti.hItem
                    If TVEntries(lp).bFolder Then
                        fFolder = 1
                    Else
                        fFolder = 0
                    End If
                    fValid = 1
                    TreeView_SelectDropTarget hTVD, tvhti.hItem
            End If
                TVDragOver = tvhti.hItem
        If (lPrevItem <> -1) And (lPrevItem <> tvhti.hItem) Then
                If TreeView_GetItemState(hwnd, lPrevItem, TVIS_DROPHILITED) Then
                    TreeView_SetItemState hwnd, lPrevItem, 0&, TVIS_DROPHILITED
                    
                End If
        End If
    Else
        TVDragOver = tvhti.hItem
    End If
Else
    If (lPrevItem <> -1) Then
            If TreeView_GetItemState(hwnd, lPrevItem, TVIS_DROPHILITED) Then
                TreeView_SetItemState hwnd, lPrevItem, 0&, TVIS_DROPHILITED
'                TreeView_SetItemState hwnd, lPrevItem, 0&, TVIS_SELECTED
            End If
    End If
    TVDragOver = -1
End If
If (tvhti.Flags And TVHT_ONITEMBUTTON) Then
    DebugAppend "onbutton"
End If
        
End Function

Private Function GetTVItemText(hTVD As LongPtr, _
                                hItem As LongPtr, _
                                Optional cbItem As Long = MAX_ITEM) As String
  Dim tVI As TVITEM
  
  ' Initialize the struct to retrieve the item's text.
  tVI.Mask = TVIF_TEXT
  tVI.hItem = hItem
  tVI.pszText = StrPtr(String$(cbItem, 0))
  tVI.cchTextMax = cbItem
  
  If TreeView_GetItem(hTVD, tVI) Then
    GetTVItemText = GetStrFromPtrA(tVI.pszText)
  End If

End Function

Private Function GetTVItemPath(hwnd As LongPtr, hItem As LongPtr) As String
Dim lp As LongPtr

lp = GetTVItemlParam(hwnd, hItem)
GetTVItemPath = TVEntries(lp).sFullPath

End Function

Private Function SetTVItemStateImage(hItem As LongPtr, iState As ucst_TVItemCheckStates) As Boolean
  Dim tVI As TVITEM
  
  tVI.Mask = TVIF_HANDLE Or TVIF_STATE
  tVI.hItem = hItem
  tVI.StateMask = TVIS_STATEIMAGEMASK
  tVI.State = IndexToStateImageMask(iState)
  
  SetTVItemStateImage = TreeView_SetItem(hTVD, tVI)
  
End Function

Private Function IndexToStateImageMask(ByVal ImgIndex As Long) As Long
    IndexToStateImageMask = ImgIndex * (2 ^ 12)
End Function

Private Function StateImageMaskToIndex(ByVal ImgState As Long) As Long
    StateImageMaskToIndex = ImgState / (2 ^ 12)
End Function

Private Function INDEXTOOVERLAYMASK(iOverlay As Long) As Long
  #If TWINBASIC Then
      Return ((iOverlay) << 8)
  #Else
    INDEXTOOVERLAYMASK = iOverlay * (2 ^ 8)
  #End If
End Function

Private Function GetFileIconIndexPIDL(pidl As LongPtr, uType As Long) As Long
  Dim sfi As SHFILEINFO
  If SHGetFileInfo(pidl, 0, sfi, LenB(sfi), SHGFI_PIDL Or SHGFI_SYSICONINDEX Or uType) Then
    GetFileIconIndexPIDL = sfi.iIcon
  End If
End Function

Public Function GetExpansionState() As String
'Returns a set of folders that if expanded to, will replicate the current appearance of the tree.
'This is *not* a list of all folders, just enough to put the treeview back to the state it's in when this is called.
Dim sData() As String
If CalcRefreshData(sData) Then
    GetExpansionState = Join(sData, "|")
End If

End Function

Public Sub LoadExpansionState(sList As String, Optional bResetFirst As Boolean = True, Optional bExpandItems As Boolean = False)
'Takes a list of directories to expand to, delimited by |
'Generally for the list generated by GetExpansionState
Dim i As Long
Dim sData() As String
If sList = "" Then Exit Sub

sData = Split(sList, "|")

If bResetFirst Then ResetTreeView

For i = 0 To UBound(sData)
    OpenToPath sData(i), bExpandItems
Next i

End Sub
Private Sub EnumRoot()
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim tvins As TVINSERTSTRUCTEX
Dim tVI As TVITEMEX
Dim siDesk As IShellItem
Dim siChild As IShellItem
Dim pEnum As IEnumShellItems, penum2 As IEnumShellItems
Dim upi As IParentAndItem
Dim psf As IShellFolder
Dim pIcon As IShellIcon
Dim pIconOvr As IShellIconOverlay
Dim lpIconOvr As Long, lpIconOvr2 As Long
Dim pidlDesktop As LongPtr
Dim pidlPar As LongPtr, pidlRel As LongPtr
Dim lpIcon As Long
Dim pcl As Long, pcl2 As Long
Dim nCur As Long
Dim lAtr As SFGAOF
Dim lpName As LongPtr, sName As String
Dim lpFull As LongPtr, sFull As String
Dim lpNameFull As LongPtr
Dim hr As Long

On Error GoTo e0
If mFavorites Then
nCur = 1&
End If
ReDim TVEntries(0)
fLoad = 1
Dim pKFM As KnownFolderManager
Dim pkf As IKnownFolder
Dim siFav As IShellItem
Dim pPst As IPersistIDList
Dim hFav As LongPtr
Set pKFM = New KnownFolderManager
If mFavorites Then
DebugAppend "m_Win10QA=" & m_Win10QA & ", bIsWin10OrGreater=" & bIsWin10OrGreater
    If (m_Win10QA = True) And (bIsWin10OrGreater = True) Then
        SHCreateItemFromParsingName StrPtr(sQuickAccess), Nothing, IID_IShellItem, siFav
        bQkAc = True
    Else
        SHGetKnownFolderItem FOLDERID_Favorites, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siFav
    End If
    If (siFav Is Nothing) = False Then
        ReDim Preserve TVEntries(1)
        nCur = 1
        siFav.GetDisplayName SIGDN_NORMALDISPLAY, lpName
        sName = LPWSTRtoStr(lpName)
        DebugAppend "FavName=" & sName
        siFav.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
        TVEntries(1).sNameFull = LPWSTRtoStr(lpNameFull)
        siFav.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
        sFavPath = LPWSTRtoStr(lpFull)
        TVEntries(1).sFullPath = "1"
'        Call SHGetKnownFolderIDList(FOLDERID_Favorites, KF_FLAG_DEFAULT, 0&, pidlDesktop)
'        lpIcon = GetFileIconIndexPIDL(pidlDesktop, SHGFI_SMALLICON)
        Dim pUnkFav As IUnknownUnrestricted
        Set pUnkFav = siFav
        hr = pUnkFav.QueryInterface(IID_IParentAndItem, upi)
        Dim pidlParF As LongPtr, pidlChF As LongPtr
        If hr = S_OK Then
            If (upi Is Nothing) = False Then
                Dim psfFav As IShellFolder
                Dim pUnkIco As IUnknownUnrestricted
                Dim pIcoFav As IShellIcon
                upi.GetParentAndItem pidlParF, psfFav, pidlChF
                Set pUnkIco = psfFav
                hr = pUnkIco.QueryInterface(IID_IShellIcon, pIcoFav)
                If hr = S_OK Then
                   pIcoFav.GetIconOf pidlChF, GIL_FORSHELL, lpIcon
                End If
            End If
        Else
            hr = pUnkFav.QueryInterface(IID_IPersistIDList, pPst)
            If hr = S_OK Then
                pPst.GetIDList pidlParF
                lpIcon = GetFileIconIndexPIDL(pidlParF, SHGFI_SMALLICON)
            End If
        End If
        If pidlParF Then CoTaskMemFree pidlParF
        Dim pidlFav As LongPtr
        Dim ppidl As IPersistIDList
        Set ppidl = siFav
        ppidl.GetIDList(pidlFav)
        siFav.GetAttributes SFGAO_FOLDER Or SFGAO_FILESYSANCESTOR Or SFGAO_STREAM, lAtr
        TVEntries(1).nIcon = TranslateIcon(lpIcon, siFav, lAtr, pidlParF, pidlFav, mIconSize * m_ScaleX, mIconSize * m_ScaleY, pidlChF)
        tVI.Mask = TVIF_CHILDREN Or TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE Or TVIF_PARAM Or TVIF_STATE
        tVI.cChildren = 1
        TVEntries(1).sName = sName
        TVEntries(1).bIsDefItem = True
        tVI.cchTextMax = Len(sName)
        tVI.pszText = StrPtr(sName)
        tVI.iImage = lpIcon
        tVI.iSelectedImage = lpIcon
        tVI.StateMask = TVIS_STATEIMAGEMASK
        tVI.State = IndexToStateImageMask(0)
        tVI.lParam = 1
        DebugAppend "FavName=" & TVEntries(1).sName
        tvins.hInsertAfter = 0
        tvins.hParent = TVI_ROOT
        tvins.Item = tVI
        
        m_hFav = SendMessage(hTVD, TVM_INSERTITEMW, 0&, tvins)
        TreeView_SetCheckStateEx hTVD, m_hFav, 0
        TVEntries(1).hNode = m_hFav
        TVEntries(1).hParentNode = -1
        
        TVEntries(1).dwAttrib = lAtr
    '    TVEntries(1).bFolder = True
        TVEntries(1).bDropTarget = True
        pKFM.GetFolder FOLDERID_Favorites, pkf
        pkf.GetIDList KF_FLAG_DEFAULT, TVEntries(1).pidlFQ
        DebugAppend "hFav=" & m_hFav & ",hTVD=" & hTVD
        TreeView_Expand hTVD, m_hFav, TVE_EXPAND
        UpdateWindow hTVD
            DebugAppend "FavName=" & TVEntries(1).sName
    Else
        DebugAppend "Failed to create Favorites"
    End If
End If
Dim pkfr As IKnownFolder
Dim pidlFQR As LongPtr
If mComputerAsRoot Then
    SHGetKnownFolderItem FOLDERID_ComputerFolder, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siDesk
    pKFM.GetFolder FOLDERID_ComputerFolder, pkfr
    pkfr.GetIDList KF_FLAG_DEFAULT, pidlFQR
Else
    Set siDesk = Nothing
    If mCustomRoot <> "" Then
        SHCreateItemFromParsingName StrPtr(mCustomRoot), Nothing, IID_IShellItem, siDesk
        pidlFQR = ILCreateFromPathW(StrPtr(mCustomRoot))
    End If
    If (siDesk Is Nothing) = False Then
        bCustRt = True
    Else
        Call SHCreateItemFromIDList(VarPtr(0&), IID_IShellItem, siDesk)
        pKFM.GetFolder FOLDERID_Desktop, pkfr
        pkfr.GetIDList KF_FLAG_DEFAULT, pidlFQR
    End If
    TVEntries(0).bDropTarget = True
End If
If (siDesk Is Nothing) = False Then
    siDesk.GetDisplayName SIGDN_NORMALDISPLAY, lpName
    sName = LPWSTRtoStr(lpName)
    siDesk.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
    TVEntries(0).sNameFull = LPWSTRtoStr(lpNameFull)
    siDesk.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
    sFull = LPWSTRtoStr(lpFull)
    If mComputerAsRoot Then
        Call SHGetKnownFolderIDList(FOLDERID_ComputerFolder, KF_FLAG_DEFAULT, 0&, pidlDesktop)
        lpIcon = GetFileIconIndexPIDL(pidlDesktop, SHGFI_SMALLICON)
    Else
        If bCustRt = False Then
            pidlDesktop = GetPIDLFromFolderID(0&, CSIDL_DESKTOP)
            lpIcon = GetFileIconIndexPIDL(pidlDesktop, SHGFI_SMALLICON)
        Else
            pidlDesktop = ILCreateFromPathW(StrPtr(mCustomRoot))
            lpIcon = GetFileIconIndexPIDL(pidlDesktop, SHGFI_SMALLICON)
            Dim pUnk As IUnknownUnrestricted
            Set upi = siDesk
            upi.GetParentAndItem pidlPar, psf, pidlRel
            On Error Resume Next
            If (psf Is Nothing) = False Then
                Set pUnk = psf
                hr = pUnk.QueryInterface(IID_IShellIcon, pIcon)
                If hr = S_OK Then
                    pIcon.GetIconOf pidlRel, GIL_FORSHELL, lpIcon
                Else
                  Dim pidlcb As LongPtr
                  pidlcb = ILCombine(pidlPar, pidlRel)
                  lpIcon = GetFileIconIndexPIDL(pidlcb, SHGFI_SMALLICON)
                  DebugAppend "lpIcon on fallback=" & lpIcon
                End If
                If lpIcon = -1 Then lpIcon = 0
            End If
        End If
        sDesktopPath = sFull
    End If
    CoTaskMemFree pidlDesktop
    TVEntries(0).nIcon = TranslateIcon(lpIcon, siDesk, lAtr, 0, pidlDesktop, mIconSize * m_ScaleX, mIconSize * m_ScaleY, 0)
    tVI.Mask = TVIF_CHILDREN Or TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE Or TVIF_PARAM Or TVIF_STATE
    tVI.cChildren = 1
    TVEntries(0).sName = sName
    tVI.cchTextMax = Len(sName)
    tVI.pszText = StrPtr(sName)
    tVI.iImage = TVEntries(0).nIcon
    tVI.iSelectedImage = TVEntries(0).nIcon
    tVI.StateMask = TVIS_STATEIMAGEMASK
    tVI.State = IndexToStateImageMask(0)
    tVI.lParam = 0&
    
    tvins.hInsertAfter = 0
    tvins.hParent = TVI_ROOT
    tvins.Item = tVI
    
    m_hRoot = SendMessage(hTVD, TVM_INSERTITEMW, 0&, tvins)
    If mRootHasCheckbox = False Then
        TreeView_SetCheckStateEx hTVD, m_hRoot, 0
    End If
    TVEntries(0).hNode = m_hRoot
    TVEntries(0).hParentNode = -1
    siDesk.GetAttributes SFGAO_FOLDER Or SFGAO_FILESYSANCESTOR Or SFGAO_STREAM, lAtr
    TVEntries(0).dwAttrib = lAtr
    TVEntries(0).sFullPath = "0"
    TVEntries(0).bFolder = True
    TVEntries(0).pidlFQ = pidlFQR
    TVEntries(0).bIsDefItem = True
    DebugAppend "m_hRoot=" & m_hRoot & ",hTVD=" & hTVD
    TreeView_Expand hTVD, m_hRoot, TVE_EXPAND
    UpdateWindow hTVD
End If


'<EhFooter>
fLoad = 0
Exit Sub

e0:
    DebugAppend "ucShellTree.EnumRoot->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Sub

Private Function RenameFile(sOld As String, sNewName As String) As Long
DebugAppend "Rename::Enter,old=" & sOld & ",new=" & sNewName
Dim cFO2 As FileOperation
Set cFO2 = New FileOperation

Dim siItem As IShellItem

SHCreateItemFromParsingName StrPtr(sOld), Nothing, IID_IShellItem, siItem
If (siItem Is Nothing) = False Then
    cFO2.RenameItem siItem, StrPtr(sNewName), Nothing 'ByVal 0&
    DebugAppend "Rename::SetOps"
    cFO2.SetOperationFlags IFO_ALLOWUNDO
    cFO2.SetOwnerWindow hTVD
    DebugAppend "Rename::Exec"
    cFO2.PerformOperations
    DebugAppend "Rename::CheckAbort"
    cFO2.GetAnyOperationsAborted RenameFile
End If
Set cFO2 = Nothing
Set siItem = Nothing

End Function

Private Function DeleteFile(siFile() As String) As Long
Dim shfos As SHFILEOPSTRUCT
Dim sList As String
Dim i As Long

For i = 0 To UBound(siFile)
    If siFile(i) <> "" Then
        sList = sList & siFile(i) & vbNullChar
    End If
Next i
sList = sList & vbNullChar
DebugAppend "DeleteToBinW->" & sList
With shfos
    .hWnd = hTVD
    .wFunc = FO_DELETE
    .pFrom = StrPtr(sList)
'    .fFlags = FOF_ALLOWUNDO
'    If bDeletePrompt Then
'        .fFlags = .fFlags Or FOF_NOCONFIRMATION
'    End If
End With

DeleteFile = SHFileOperationW(shfos)
End Function

Private Function EmptyTreeView(hTVD As LongPtr, fRedraw As Boolean) As Boolean
    
    ' Prevents any TVN_SELCHANGING/ED processing
    g_fDeleting = True
  
    ' (generates a TVN_DELETEITEM for each added item)
    Call SendMessage(hTVD, WM_SETREDRAW, ByVal 0, 0)
    ' TreeView_DeleteAllItems invokes TVN_SELCHANGING/ED, this doesn't
    EmptyTreeView = TreeView_DeleteItem(hTVD, TreeView_GetRoot(hTVD))
    If m_hFav Then
        TreeView_DeleteItem hTVD, m_hFav
    End If
    If m_hRoot Then
        TreeView_DeleteItem hTVD, m_hRoot
    End If
    
    Call SendMessage(hTVD, WM_SETREDRAW, ByVal 1, 0)
  
    g_fDeleting = False
  
    If fRedraw Then Call UpdateWindow(hTVD)

End Function

Private Sub Hourglass(fOn As Boolean)
If fOn Then
    Call SetCursor(LoadCursor(0, ByVal IDC_WAIT))
Else
    Call SetCursor(LoadCursor(0, ByVal IDC_ARROW))
End If
End Sub

Private Function ExplorerSettingEnabled(lSetting As SFS_MASK) As Boolean
Dim lintg As Integer
Call SHGetSettings(lintg, lSetting)
Select Case lSetting
    Case SSF_SHOWALLOBJECTS
        ExplorerSettingEnabled = lintg And 2 ^ 0 'fShowAllObjects
    Case SSF_SHOWEXTENSIONS
        ExplorerSettingEnabled = lintg And 2 ^ 1 'fShowExtensions
    Case SSF_NOCONFIRMRECYCLE
        ExplorerSettingEnabled = lintg And 2 ^ 2 'fNoConfirmRecycly
    Case SSF_SHOWSYSFILES
        ExplorerSettingEnabled = lintg And 2 ^ 3 'fShowSysFiles
    Case SSF_SHOWCOMPCOLOR
        ExplorerSettingEnabled = lintg And 2 ^ 4 'fShowCompColor
    Case SSF_DOUBLECLICKINWEBVIEW
        ExplorerSettingEnabled = lintg And 2 ^ 5 'fDoubleClickInWebView
    Case SSF_DESKTOPHTML
        ExplorerSettingEnabled = lintg And 2 ^ 6 'fDesktopHTML
    Case SSF_WIN95CLASSIC
        ExplorerSettingEnabled = lintg And 2 ^ 7 'fWin95Classic
    Case SSF_DONTPRETTYPATH
        ExplorerSettingEnabled = lintg And 2 ^ 8 'fDontPrettyPath
    Case SSF_SHOWATTRIBCOL
        ExplorerSettingEnabled = lintg And 2 ^ 9 'fShowAttribCol
    Case SSF_MAPNETDRVBUTTON
        ExplorerSettingEnabled = lintg And 2 ^ 10 'fMapNetDrvButton
    Case SSF_SHOWINFOTIP
        ExplorerSettingEnabled = lintg And 2 ^ 11 'fShowInfoTip
    Case SSF_HIDEICONS
        ExplorerSettingEnabled = lintg And 2 ^ 12 'fHideIcons
    Case SSF_SHOWSUPERHIDDEN
        Dim SS As SHELLSTATE
        SHGetSetSettings SS, SSF_SHOWSUPERHIDDEN
        ExplorerSettingEnabled = ((SS.fFlags1 And fShowSuperHidden) = fShowSuperHidden)
        
End Select
End Function

Private Function DataObjSupportsFormat(pIDO As IDataObject, lFmt As Long, Optional ty As TYMED = TYMED_HGLOBAL, Optional lIndex As Long = -1, Optional dva As DVASPECT = DVASPECT_CONTENT, Optional lDev As LongPtr = 0) As Boolean
Dim tFMT As FORMATETC
With tFMT
    .cfFormat = lFmt
    .tymed = ty
    .dwAspect = dva
    .lIndex = lIndex
    .ptd = lDev
End With

If pIDO.QueryGetData(tFMT) = S_OK Then
    DataObjSupportsFormat = True
End If
End Function

Private Function PidlIsSame(pidl1 As LongPtr, pidl2 As LongPtr) As Boolean
Dim si1 As IShellItem, si2 As IShellItem
Dim lp1 As LongPtr, lp2 As LongPtr
Dim sp1 As String, sp2 As String
SHCreateItemFromIDList pidl1, IID_IShellItem, si1
SHCreateItemFromIDList pidl2, IID_IShellItem, si2
si1.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lp1
sp1 = LPWSTRtoStr(lp1)
si2.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lp2
sp2 = LPWSTRtoStr(lp2)
PidlIsSame = (LCase$(sp1) = LCase$(sp2))
End Function

Public Function InsertItemByPath(sPath As String, Optional sParent As String = "0") As Boolean
Dim hNodePar As LongPtr
Dim lIdxPar As Long
Dim siItem As IShellItem

CreateCurrentMap
lIdxPar = GetMapIdxByPath(sParent)
If lIdxPar > -1& Then
    hNodePar = TVVisMap(lIdxPar).hNode
    SHCreateItemFromParsingName StrPtr(sPath), Nothing, IID_IShellItem, siItem
    If (siItem Is Nothing) = False Then
        TVAddItem siItem, hNodePar, False, True
        InsertItemByPath = True
    Else
        DebugAppend "InsertItemByPath->Couldn't create IShellItem for target."
    End If
Else
    DebugAppend "InsertItemByPath->Invalid parent specified. Item must already be visible."
End If
End Function
Public Function InsertItemByPidl(pidl As LongPtr, Optional pidlPar As LongPtr = 0) As Boolean
Dim hNodePar As LongPtr
Dim lIdxPar As Long
Dim siItem As IShellItem

CreateCurrentMap
If pidlPar Then
    Dim i As Long
    For i = 0 To UBound(TVVisMap)
        If PidlIsSame(TVVisMap(i).pidlFQ, pidlPar) Then
            lIdxPar = i
            Exit For
        End If
    Next i
Else
    lIdxPar = GetMapIdxByPath("0")
End If
If lIdxPar > -1& Then
    hNodePar = TVVisMap(lIdxPar).hNode
    SHCreateItemFromIDList pidl, IID_IShellItem, siItem
    If (siItem Is Nothing) = False Then
        TVAddItem siItem, hNodePar, False, True
        InsertItemByPidl = True
    Else
        DebugAppend "InsertItemByPidl->Couldn't create IShellItem for target."
    End If
Else
    DebugAppend "InsertItemByPidl->Invalid parent specified. Item must already be visible."
End If
End Function

Private Sub TVAddItem(siChild As IShellItem, hitemParent As LongPtr, Optional bForceEnable As Boolean = False, Optional bNoFilter As Boolean = False)
On Error GoTo e0
Dim tvins As TVINSERTSTRUCTEX
Dim tVI As TVITEMEX
Dim siParent As IShellItem
'Dim siChild As IShellItem
Dim pEnum As IEnumShellItems, penum2 As IEnumShellItems
Dim upi As IParentAndItem
Dim psf As IShellFolder
Dim pIcon As IShellIcon
Dim pIconOvr As IShellIconOverlay
Dim lpIconOvr As Long, lpIconOvr2 As Long
Dim pidlDesktop As LongPtr
Dim pidlPar As LongPtr, pidlRel As LongPtr
Dim lpIcon As Long
Dim pcl As Long, pcl2 As Long
Dim lAtr As SFGAOF
Dim lpName As LongPtr, sName As String
Dim lpFull As LongPtr, sFull As String
Dim lpNameFull As LongPtr, sNameFull As String
Dim idx As Long
Dim fSubFolder As Long
Dim hitemPrev As LongPtr
Dim pUnk As IUnknownUnrestricted
Dim bFolder As Boolean, bZip As Boolean
Dim hr As Long
Dim bFav As Boolean
Dim fDisable As Long
Dim pPer As IPersistIDList
Dim sFPP As String
Dim i As Long
siChild.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
sFPP = LPWSTRtoStr(lpFull)
DebugAppend "TVAddItem " & sFPP
'For i = 0 To UBound(TVEntries)
'    If TVEntries(i).sFullPath = sFPP Then Exit Sub
'End If

lpName = 0: sName = "": lpFull = 0: sFull = "": lpIcon = 0&: lpIconOvr = 0&: lAtr = 0&: bFolder = False: bZip = False: fDisable = 0&
siChild.GetAttributes SFGAO_CAPABILITYMASK Or SFGAO_CONTENTSMASK Or SFGAO_PKEYSFGAOMASK Or SFGAO_STORAGECAPMASK Or SFGAO_COMPRESSED Or SFGAO_ENCRYPTED Or SFGAO_SHARE, lAtr
If ((lAtr And SFGAO_FOLDER) = SFGAO_FOLDER) Or (mShowFiles = True) Or (bFav = True) Then
    If (((mShowFiles = False) And ((mExpandZip = False) And (lAtr And SFGAO_STREAM) = 0&) Or (mExpandZip = True))) Or (bFav = True) Or (mShowFiles = True) Then 'exlude .zip/.cab
        siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
        sNameFull = LPWSTRtoStr(lpNameFull)
        If (lAtr And SFGAO_FOLDER) = SFGAO_FOLDER Then
            bFolder = True
            If (lAtr And SFGAO_STREAM) = SFGAO_STREAM Then
                bZip = True
            End If
        End If
        If bNoFilter = False Then
            If (mFilter <> "*.*") And (mFilter <> "") Then
                If bFolder Then
                    If mFilterFilesOnly = False Then
                        If InStr(mFilter, ";") Then
                            If PathMatchSpecExW(StrPtr(sNameFull), StrPtr(mFilter), PMSF_MULTIPLE) = 0& Then Exit Sub
                        Else
                            If PathMatchSpecW(StrPtr(sNameFull), StrPtr(mFilter)) = 0& Then Exit Sub
                        End If
                    End If
                Else
                    If InStr(mFilter, ";") Then
                        If PathMatchSpecExW(StrPtr(sNameFull), StrPtr(mFilter), PMSF_MULTIPLE) = 0& Then Exit Sub
                    Else
                        If PathMatchSpecW(StrPtr(sNameFull), StrPtr(mFilter)) = 0& Then Exit Sub
                    End If
                End If
            End If
        End If
        nCur = nCur + 1
        ReDim Preserve TVEntries(nCur)
        fSubFolder = 1
        tVI.Mask = TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE Or TVIF_PARAM Or TVIF_STATEEX 'Or TVIF_STATE
        If (((lAtr And SFGAO_FILESYSANCESTOR) = False) And ((lAtr And SFGAO_FILESYSTEM) = False)) Or ((lAtr And SFGAO_NONENUMERATED) = SFGAO_NONENUMERATED) Then
'            If bForceEnable = False Then
'                fDisable = 1&
'            Else
'                fDisable = 0&
'            End If
        End If
        If fDisable = 0& Then
            If (bZip = False) Or ((bZip = True) And (mNeverExpandZip = False)) Then
                If (lAtr And SFGAO_HASSUBFOLDER) = SFGAO_HASSUBFOLDER Then
                    If (TVEntries(nCur).bZip = False) Or ((TVEntries(nCur).bZip = True) And (mExpandZip = True)) Then
                        tVI.cChildren = 1
                        tVI.Mask = tVI.Mask Or TVIF_CHILDREN
                    End If
                Else
                    If (mShowFiles = True) Then
                        If bFolder = True Then
                            If FolderIsEmpty(siChild) = False Then
                                tVI.cChildren = 1
                                tVI.Mask = tVI.Mask Or TVIF_CHILDREN
                            End If
                        End If
                    End If
                End If
            End If
        End If
        If (mShowFiles = True) And (mExpandZip = False) Then
            If (bFolder = True) And (bZip = True) Then
                bFolder = False
            End If
        End If
        siChild.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
        sFull = LPWSTRtoStr(lpFull)
        siChild.GetDisplayName SIGDN_NORMALDISPLAY, lpName
        sName = LPWSTRtoStr(lpName)
        If m_ForceExt = STEP_AlwaysShow Then
            ' siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
            ' sNameFull = LPWSTRtoStr(lpNameFull)
            If (Left$(sNameFull, 3) <> "::{") And (Left$(sNameFull, 5) <> "uuid:") And ((InStr(sNameFull, "\?\usb#")) = 0) And (Left$(sNameFull, 7) <> "usb#vid") Then
                sName = sNameFull
            End If
        End If
        TVEntries(nCur).sFullPath = sFull
        TVEntries(nCur).sName = sName
        TVEntries(nCur).bFolder = bFolder
        TVEntries(nCur).sParentFull = StrGetPath(TVEntries(nCur).sFullPath)
        TVEntries(nCur).sNameFull = sNameFull
        TVEntries(nCur).bZip = bZip
        TVEntries(nCur).dwAttrib = lAtr
        If (lAtr And SFGAO_DROPTARGET) = SFGAO_DROPTARGET Then
            TVEntries(nCur).bDropTarget = True
        End If
        Set upi = siChild
        upi.GetParentAndItem pidlPar, psf, pidlRel
'                    Set si2Child = siChild
        Set pPer = siChild
        pPer.GetIDList TVEntries(nCur).pidlFQ
        TVEntries(nCur).pidlFQPar = pidlPar
        On Error Resume Next
        If (psf Is Nothing) = False Then
''            DebugAppend "psf is valid, set pIcon with pidlRel=" & pidlRel & ",pidl=" & pidlPar
'            Set pIcon = psf
            Set pUnk = psf
            hr = pUnk.QueryInterface(IID_IShellIcon, pIcon)
            'DebugAppend "QueryInterface=0x" & Hex$(hr)
            If hr = S_OK Then
                pIcon.GetIconOf pidlRel, GIL_FORSHELL, lpIcon
            Else
              Dim pidlcb As LongPtr
              pidlcb = ILCombine(pidlPar, pidlRel)
'              DebugAppend "pidlcb=" & pidlcb
              lpIcon = GetFileIconIndexPIDL(pidlcb, SHGFI_SMALLICON)
              DebugAppend "lpIcon on fallback=" & lpIcon
            End If
            If lpIcon = -1 Then lpIcon = 0
            
        End If
        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
        EnsureOverlay lpIconOvr
        On Error GoTo e0
        TVEntries(nCur).nIcon = TranslateIcon(lpIcon, siChild, lAtr, pidlPar, TVEntries(nCur).pidlFQ, mIconSize * m_ScaleX, mIconSize * m_ScaleY, pidlRel)
        TVEntries(nCur).nOverlay = lpIconOvr
        TVEntries(nCur).pidlRel = pidlRel
        TVEntries(nCur).hParentNode = hitemParent
        If (lAtr And SFGAO_LINK) = SFGAO_LINK Then
            TVEntries(nCur).bLink = True
            TVEntries(nCur).sLinkTarget = GetLinkTarget(siChild)
            If TVEntries(nCur).sLinkTarget = "" Then TVEntries(nCur).LinkPIDL = GetLinkTargetPIDL(siChild)
            If PathIsDirectoryW(StrPtr(TVEntries(nCur).sLinkTarget)) Then
                TVEntries(nCur).bLinkIsFolder = True
            End If
        End If
        tVI.cchTextMax = Len(TVEntries(nCur).sName)
        tVI.pszText = StrPtr(TVEntries(nCur).sName)
        tVI.iImage = TVEntries(nCur).nIcon
        tVI.iSelectedImage = TVEntries(nCur).nIcon
        tVI.lParam = nCur
        If lpIconOvr > -1 Then
            tVI.Mask = tVI.Mask Or TVIF_STATE
            tVI.StateMask = TVIS_OVERLAYMASK
            tVI.State = INDEXTOOVERLAYMASK(lpIconOvr)
        End If
        
        tvins.hParent = hitemParent
        tvins.hInsertAfter = hitemPrev
        tvins.Item = tVI
        hitemPrev = SendMessage(hTVD, TVM_INSERTITEMW, 0&, tvins)
        DebugAppend "Add@" & nCur & " " & sFPP
        TVEntries(nCur).hNode = hitemPrev
        If TreeView_GetCheckState(hTVD, hitemParent) = 2 Then
            TreeView_SetCheckState hTVD, hitemPrev, 1
        End If

        If fDisable Then
            DebugAppend "TVExpandFolder->Disable " & TVEntries(nCur).sName
            TreeView_SetItemStateEx hTVD, hitemPrev, TVIS_EX_DISABLED
        End If
        
        If (bFolder = True) And (mShowOnlyFileCheckbox = True) And (mShowFiles = True) Then
            TreeView_SetCheckState hTVD, hitemPrev, 0
        End If
        
        'Re-sort the new item
        Set psfCur = psf
        Dim tvscb As TVSORTCB
        tvscb.hParent = hitemParent
        If m_cbSort = 0& Then m_cbSort = FARPROC(AddressOf TVSortProc)
        tvscb.lpfnCompare = m_cbSort
        tvscb.lParam = ObjPtr(Me)
        lParamSort = 0
        Call TreeView_SortChildrenCB(hTVD, tvscb, 0&)
    End If
End If
SetFocusAPI UserControl.ContainerHwnd
SetFocusAPI hTVD
Exit Sub

e0:
    DebugAppend "ucShellTree.TVAddItem->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Sub

Private Function TranslateIcon(nIcon As Long, si As IShellItem, dwAttr As SFGAOF, pidlFQCur As LongPtr, pidlFQ As LongPtr, cx As Long, cy As Long, Optional pidlRel As LongPtr = 0, Optional bFlag1 As Boolean = False) As Long
'Takes a system image list index and returns the local TreeView index. 
'If not added already, adds it.
Dim lIdx As Long
lIdx = SysImlCacheLookup(nIcon)
If lIdx > -1 Then
    'Debug.Print "TranslateIcon " & nIcon & "|" & lIdx & " (Cached)"
    Return lIdx
End If
lIdx = AddToHIMLNoDLL(himlTV, si, dwAttr, pidlFQCur, pidlFQ, cx, cy, pidlRel)
ReDim Preserve SysImgCache(nSysImgCache)
SysImgCache(nSysImgCache).sysimlid = nIcon
SysImgCache(nSysImgCache).limlidx = lIdx
nSysImgCache = nSysImgCache + 1
'Debug.Print "TranslateIcon " & nIcon & "|" & lIdx & " (added)"
Return lIdx
End Function

Private Function EnsureOverlay(nIdx As Long) As Long
    If nIdx = -1 Then Return 0
    Debug.Print "added = " & bOvrAdded(nIdx)
    
    If bOvrAdded(nIdx) Then Return 1
    
    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


Private Function SysImlCacheLookup(nFI As Long) As Long
Dim i As Long
For i = 0 To UBound(SysImgCache)
    If SysImgCache(i).sysimlid = nFI Then
        SysImlCacheLookup = SysImgCache(i).limlidx
        Exit Function
    End If
Next i
SysImlCacheLookup = -1
End Function
Private Function AddToHIMLNoDLL(himl As LongPtr, si As IShellItem, dwAttr As SFGAOF, pidlFQCur As LongPtr, pidlFQ As LongPtr, cx As Long, cy As Long, Optional pidlRel As LongPtr = 0) As Long
Dim isiif As IShellItemImageFactory
Dim hr As Long
Dim pidlcr As LongPtr
Dim hBmp As LongPtr
If (si Is Nothing) Then
    If (pidlFQ = 0&) And (pidlRel <> 0&) Then
        'Virtual object; try to recreate pidl
        pidlcr = ILCombine(pidlFQCur, pidlRel)
    Else
        pidlcr = pidlFQ
    End If
    hr = SHCreateItemFromIDList(pidlcr, IID_IShellItemImageFactory, isiif)
Else
    Set isiif = si
End If
    
Dim tsz As SIZE
tsz.cx = cx: tsz.cy = cy
Dim lFlags As SIIGBF
If (dwAttr And SFGAO_FOLDER) = SFGAO_FOLDER Then
    lFlags = SIIGBF_ICONONLY Or SIIGBF_INCACHEONLY
Else
    lFlags = SIIGBF_ICONONLY
End If
hr = isiif.GetImage(tsz, lFlags, hBmp)
If hr = S_OK Then
'    If ThumbShouldFrame(hBmp) Then
'        hr = E_FAIL 'This manual checking should only be needed for IL_AddMasked
                    'But it can't hurt to verify anyway; when a fail is returned
                    'from this function it goes to the GDIP scaler/framer.
'    End If
Else
    lFlags = SIIGBF_ICONONLY
    hr = isiif.GetImage(tsz, lFlags, hBmp)
End If
        
If hr = S_OK Then
    Dim clrMsk As Long
    If IsComCtl6 = False Then
        OleTranslateColor clrFore, 0&, clrMsk
        AddToHIMLNoDLL = ImageList_AddMasked(himl, hBmp, clrMsk)
    Else
        AddToHIMLNoDLL = ImageList_Add(himl, hBmp, 0&)
        If (AddToHIMLNoDLL = -1) And (hBmp <> 0) And (hBmp <> -1) Then
            AddToHIMLNoDLL = AddToImageListEx(himl, hBmp, cx, cy)
        End If
                
    End If
    DeleteObject hBmp
Else
    AddToHIMLNoDLL = -1
End If
    
Set isiif = Nothing
    Debug.Print "AddToHIMLNoDLL return=" & AddToHIMLNoDLL
End Function
Private Function AddToImageListEx(himl As LongPtr, hBmp As LongPtr, minX As Long, minY As Long) As Long
'imagelist_add seems to fail if an image is smaller than the requested size
'despite the fact that a valid hThumb is returned
'this function will scale the image up, then try to add
    
Dim lX As Long, lY As Long
Dim hDC As LongPtr
Dim hBmpNew As LongPtr
Dim gimg As LongPtr
On Error GoTo e0
    
GdipCreateBitmapFromHBITMAP hBmp, ByVal 0&, gimg
If gimg Then
    GdipGetImageWidth gimg, lX
    GdipGetImageHeight gimg, lY
        
'    If (lX < minX) Or (lY < minY) Then
        DebugAppend "Addhimlex: resizing"
        InitDC hDC, hBmpNew, &HFF000000, minX, minY
        'gdipResize gimg, hDC, minX, minY, True
        If (lX > minX) Or (lY > minY) Then
            gdipResize gimg, hDC, minX, minY, True
            'gdipDrawCentered gimg, hDC, minX, minY, False
        ElseIf (lX = minX) Or (lY = minY) Then
            gdipDrawCenteredNoScale gimg, hDC, minX, minY
        Else
            gdipDrawCentered gimg, hDC, minX, minY, True
        End If
        GdipDisposeImage gimg
        GetBitmap hDC, hBmpNew
'    Else
'        DebugAppend "addhimlex: using original"
'        hBmpNew = hBmp
'    End If
Else
    DebugAppend "addhimlex failed to generate gdip image"
    hBmpNew = hBmp
End If
If IsComCtl6 = False Then
    Dim clrMsk As Long
    OleTranslateColor clrFore, 0&, clrMsk
    AddToImageListEx = ImageList_AddMasked(himl, hBmpNew, clrMsk)
Else
    AddToImageListEx = ImageList_Add(himl, hBmpNew, 0&)
End If
    
On Error GoTo 0
Exit Function
    
e0:
DebugAppend "ucShellBrowse.AddToImageListEx.Error->" & Err.Description & " (" & Err.Number & ")"
    
End Function

' Initialises the hDC to draw
Private Sub InitDC(hDC As LongPtr, hBitmap As LongPtr, BackColor As Long, Width As Long, Height As Long)
    ' Create a memory DC and select a bitmap into it, fill it in with the backcolor
    hDC = CreateCompatibleDC(ByVal 0&)
    hBitmap = Create32BitHBITMAP(hDC, Width, Height)
    hBitmap = SelectObject(hDC, hBitmap)
        
End Sub

Private Function Create32BitHBITMAP(hDC As LongPtr, cx As Long, cy As Long) As LongPtr
Dim bmi As BITMAPINFO
    bmi.bmiHeader.biSize = LenB(bmi.bmiHeader)
    bmi.bmiHeader.biPlanes = 1
    bmi.bmiHeader.biCompression = 0
    
    bmi.bmiHeader.biWidth = cx
    bmi.bmiHeader.biHeight = cy
    bmi.bmiHeader.biBitCount = 32
    Create32BitHBITMAP = CreateDIBSection(hDC, bmi, DIB_RGB_COLORS, ByVal 0&, 0, 0)
        
End Function

' Replaces the old bitmap of the hDC, Returns the bitmap and Deletes the hDC
Private Sub GetBitmap(hDC As LongPtr, hBitmap As LongPtr)
    hBitmap = SelectObject(hDC, hBitmap)
    DeleteDC hDC
End Sub

' Resize the picture using GDI plus
Private Sub gdipResize(Img As LongPtr, hDC As LongPtr, Width As Long, Height As Long, Optional RetainRatio As Boolean = False)
    Dim graphics   As LongPtr      ' Graphics Object Pointer
    Dim OrWidth    As Long      ' Original Image Width
    Dim OrHeight   As Long      ' Original Image Height
    Dim OrRatio    As Double    ' Original Image Ratio
    Dim DesRatio   As Double    ' Destination rect Ratio
    Dim DestX      As Long      ' Destination image X
    Dim DestY      As Long      ' Destination image Y
    Dim DestWidth  As Long      ' Destination image Width
    Dim DestHeight As Long      ' Destination image Height
        
    GdipCreateFromHDC hDC, graphics
    GdipSetInterpolationMode graphics, InterpolationModeHighQualityBicubic
        
    If RetainRatio Then
        GdipGetImageWidth Img, OrWidth
        GdipGetImageHeight Img, OrHeight
            
        OrRatio = OrWidth / OrHeight
        DesRatio = Width / Height
            
        ' Calculate destination coordinates
        DestWidth = IIf(DesRatio < OrRatio, Width, Height * OrRatio)
        DestHeight = IIf(DesRatio < OrRatio, Width / OrRatio, Height)
'        DestX = (Width - DestWidth) / 2
'        DestY = (Height - DestHeight) / 2
        If DestWidth > DestHeight Then
            DestY = (DestWidth - DestHeight) '/ 2
        ElseIf DestHeight > DestWidth Then
            DestX = (DestHeight - DestWidth) '/ 2
        End If
'        DestX = 0
'        DestY = 0
    
        GdipDrawImageRectRectI graphics, Img, DestX, DestY, DestWidth, DestHeight, 0, 0, OrWidth, OrHeight, UnitPixel, 0, 0, 0
    Else
        GdipDrawImageRectI graphics, Img, 0, 0, Width, Height
    End If
    GdipDeleteGraphics graphics
End Sub

Private Sub gdipDrawCentered(Img As LongPtr, hDC As LongPtr, Width As Long, Height As Long, Optional bDrawBorder As Boolean = False)
'draw a smaller image centered on a larger background
DebugAppend "gdipDrawCentered", 9
    Dim graphics   As LongPtr      ' Graphics Object Pointer
    Dim OrWidth    As Long      ' Original Image Width
    Dim OrHeight   As Long      ' Original Image Height
    GdipGetImageWidth Img, OrWidth
    GdipGetImageHeight Img, OrHeight
    GdipCreateFromHDC hDC, graphics
    GdipSetInterpolationMode graphics, InterpolationModeHighQualityBicubic
    
    Dim DestX      As Long      ' Destination image X
    Dim DestY      As Long      ' Destination image Y
    Dim DestWidth  As Long      ' Destination image Width
    Dim DestHeight As Long      ' Destination image Height
    Dim maxCXY As Long
    Dim dRatio As Double
'If m_ThumbScaleCXY Then
If False Then
    ' maxCXY = m_ThumbCXY '* m_ScaleX
    ' dRatio = OrWidth / OrHeight
        
    ' DestWidth = OrWidth * m_ScaleX
    ' DestHeight = OrHeight * m_ScaleY
    ' If DestWidth > maxCXY Then
    '     DestWidth = maxCXY
    '     DestHeight = DestWidth \ dRatio
    ' ElseIf DestHeight > maxCXY Then
    '     DestHeight = maxCXY
    '     DestWidth = DestHeight * dRatio
    ' End If
    ' DebugAppend "gdipDraw scaled " & OrWidth & "," & OrHeight & " to " & DestWidth & "x" & DestHeight, 22
    ' DestX = (Width - DestWidth) \ 2
    ' DestY = (Height - DestHeight) \ 2
Else
    DestX = (Width - OrWidth) \ 2
    DestY = (Height - OrHeight) \ 2
End If
    
If bDrawBorder Then
    Dim hPen As LongPtr, lRet As Long
    'GdipCreatePen1 &HFFCFCFCF, 2, ByVal 2&, hPen '&HFFD6D6D6
    'Frame was hard to see on dark background; adjust for luminance
    Dim clr As Integer
    Dim cBlend As Long
    Dim col As Long
    OleTranslateColor clrBack, 0&, col
'        DebugAppend "col=" & Hex$(col)
    Dim R As Integer
    Dim g As Integer
    Dim b As Integer
    R = &HFF& And col
    g = (&HFF00& And col) \ 256
    b = (&HFF0000 And col) \ 65536
    Dim lum As Long
    lum = CLng(Round((0.2126 * R + 0.7152 * g + 0.0722 * b), 0))
'        DebugAppend "lum=" & lum
    clr = 200 - (240 - lum)
    If clr > 214 Then clr = 214
    If clr < 75 Then clr = 75
    cBlend = &HFF000000 + RGB(clr, clr, clr)
    GdipCreatePen1 cBlend, 2, ByVal 2&, hPen
    lRet = GdipDrawRectangleI(graphics, hPen, 0, 0, Width - 1, Height - 1)
    GdipDeletePen hPen
End If
    
'If m_ThumbScaleCXY Then'
If False Then
    GdipDrawImageRectRectI graphics, Img, DestX, DestY, DestWidth, DestHeight, 0, 0, OrWidth, OrHeight, UnitPixel, 0, 0, 0
Else
    GdipDrawImageRectI graphics, Img, DestX, DestY, OrWidth, OrHeight
End If
    
GdipDeleteGraphics graphics
    
End Sub

Private Sub gdipDrawCenteredNoScale(Img As LongPtr, hDC As LongPtr, Width As Long, Height As Long)
'draw a smaller image centered on a larger background
DebugAppend "gdipDrawCentered", 9
    Dim graphics   As LongPtr      ' Graphics Object Pointer
    Dim OrWidth    As Long      ' Original Image Width
    Dim OrHeight   As Long      ' Original Image Height
    GdipGetImageWidth Img, OrWidth
    GdipGetImageHeight Img, OrHeight
    GdipCreateFromHDC hDC, graphics
    GdipSetInterpolationMode graphics, InterpolationModeHighQualityBicubic
    
    Dim DestX      As Long      ' Destination image X
    Dim DestY      As Long      ' Destination image Y
    Dim DestWidth  As Long      ' Destination image Width
    Dim DestHeight As Long      ' Destination image Height
    
'If m_ThumbScaleCXY Then
'    DestWidth = OrWidth * m_ScaleX
'    DestHeight = OrHeight * m_ScaleY
'    DestX = (Width - DestWidth) \ 2
'    DestY = (Height - OrHeight) \ 2
'Else
    DestX = (Width - OrWidth) \ 2
    DestY = (Height - OrHeight) \ 2
    
    GdipDrawImageRectI graphics, Img, DestX, DestY, OrWidth, OrHeight
    
GdipDeleteGraphics graphics
    
End Sub

' Initialises GDI Plus
Private Function InitGDIPlus() As LongPtr
    Dim Token    As LongPtr
    Dim gdipInit As GdiplusStartupInput
        
    gdipInit.GdiplusVersion = 1
    GdiplusStartup Token, gdipInit, ByVal 0&
    InitGDIPlus = Token
End Function
    
' Frees GDI Plus
Private Sub FreeGDIPlus(Token As LongPtr)
    GdiplusShutdown Token
End Sub

Private Sub TVExpandFolder(lParam As LongPtr, hitemParent As LongPtr)
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
 DebugAppend "TVExpandFolder()"
Dim tvins As TVINSERTSTRUCTEX
Dim tVI As TVITEMEX
Dim siParent As IShellItem
Dim siChild As IShellItem
Dim si2 As IShellItem2
Dim pEnum As IEnumShellItems, penum2 As IEnumShellItems
Dim upi As IParentAndItem
Dim psf As IShellFolder
Dim pIcon As IShellIcon
Dim pIconOvr As IShellIconOverlay
Dim lpIconOvr As Long, lpIconOvr2 As Long
Dim pidlDesktop As LongPtr
Dim pidlPar As LongPtr, pidlRel As LongPtr
Dim lpIcon As Long
Dim pcl As Long, pcl2 As Long
Dim lAtr As SFGAOF
Dim lpName As LongPtr, sName As String
Dim lpFull As LongPtr, sFull As String
Dim lpNameFull As LongPtr, sNameFull As String
Dim idx As LongPtr
Dim fSubFolder As Long
Dim hitemPrev As LongPtr
Dim pUnk As IUnknownUnrestricted
Dim bFolder As Boolean, bZip As Boolean
Dim hr As Long
Dim bFav As Boolean
Dim ppidlp As LongPtr
Dim nCount As Long
Dim tc1 As Long, tc2 As Long
On Error GoTo e0
Call Hourglass(True)
idx = lParam
DebugAppend "TVExpandFolder::nCur=" & nCur & "ParentIndex=" & idx & ",lp=" & lParam & ",hItem=" & hitemParent & ",lookupidx=" & GetIndexFromNode(hitemParent)

If idx = -1 Then Exit Sub

If TVEntries(idx).sFullPath = "0" Then
    If mComputerAsRoot Then
        SHGetKnownFolderItem FOLDERID_ComputerFolder, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siParent
    Else
        If mCustomRoot <> "" Then
            SHCreateItemFromParsingName StrPtr(mCustomRoot), Nothing, IID_IShellItem, siParent
        End If
        If siParent Is Nothing Then
            Call SHCreateItemFromIDList(VarPtr(0&), IID_IShellItem, siParent)
        End If
    End If
ElseIf TVEntries(idx).sFullPath = "1" Then
    If (m_Win10QA = True) And (bIsWin10OrGreater = True) Then
        SHCreateItemFromParsingName StrPtr(sQuickAccess), Nothing, IID_IShellItem, siParent
    Else
        SHGetKnownFolderItem FOLDERID_Links, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siParent
'        SHGetKnownFolderItem FOLDERID_Favorites, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siFav
    End If
    bFav = True
Else
    Call SHCreateItemFromParsingName(StrPtr(TVEntries(idx).sFullPath), Nothing, IID_IShellItem, siParent)
    If (siParent Is Nothing) Then
        DebugAppend "TVExpandFolder::ParsingPath->ShellItem failed, trying to load from pidls...", 3
        If (TVEntries(idx).pidlFQPar <> 0&) And (TVEntries(idx).pidlRel <> 0&) Then
            ppidlp = ILCombine(TVEntries(idx).pidlFQPar, TVEntries(idx).pidlRel)
            SHCreateItemFromIDList ppidlp, IID_IShellItem, siParent
            If (siParent Is Nothing) = False Then
                DebugAppend "TVExpandFolder::LoadFromPidl->Success!", 3
            Else
                DebugAppend "TVExpandFolder::LoadFromPidl->Failed.", 3
            End If
        Else
            DebugAppend "TVExpandFolder::LoadFromPidl->Parent or child pidl not set.", 3
        End If
    End If
End If
Dim fDisable As Long

If (siParent Is Nothing) = False Then
    Dim pbc As IBindCtx
    Dim hrbc As Long = CreateBindCtx(0, pbc)
    If (pbc Is Nothing) = False Then
        Dim sppb As IPropertyBag
        Dim spunk As IUnknownUnrestricted
        hrbc = PSCreateMemoryPropertyStore(IID_IUnknown, spunk)
        If SUCCEEDED(hrbc) Then
            pbc.RegisterObjectParam(StrPtr(STR_PROPERTYBAG_PARAM), spunk)
            Set sppb = spunk
            If (sppb Is Nothing) = False Then
                PSPropertyBag_WriteDWORD(sppb, STR_ENUM_ITEMS_FLAGS, SHCONTF_NONFOLDERS Or SHCONTF_FOLDERS Or SHCONTF_INCLUDEHIDDEN Or SHCONTF_INCLUDESUPERHIDDEN)
                Debug.Print "Wrote BindCtx dw"
            Else
                Debug.Print "QI for PropertyBag failed"
            End If
        Else
            Debug.Print "PSCreateMemPstore failed"
        End If
        siParent.BindToHandler ObjPtr(pbc), BHID_EnumItems, IID_IEnumShellItems, pEnum
    Else
        siParent.BindToHandler 0, BHID_EnumItems, IID_IEnumShellItems, pEnum
    End If
    ' Dim psfp As IShellFolder
    ' Dim peil As IEnumIDList
    ' Dim pidlEnum As LongPtr
    ' Dim pidlPar1 As LongPtr
    ' Dim ppil As IPersistIDList
    ' Set ppil = siParent
    ' ppil.GetIDList pidlPar
    ' Dim hrbh As Long: hrbh = siParent.BindToHandler(0, BHID_SFObject, IID_IShellFolder, psfp)
    ' If (psfp Is Nothing) = False Then
    '     psfp.EnumObjects 0, SHCONTF_FOLDERS Or SHCONTF_INCLUDEHIDDEN Or SHCONTF_INCLUDESUPERHIDDEN, peil
    ' Else
    '     Debug.Print "Failed to get IShellFolder for siParent; 0x" & Hex$(hrbh)
    '     Exit Sub
    ' End If
 

    ' If (peil Is Nothing) = False Then
    '    bFilling = True
    '    tc1 = GetTickCount()
    '    Do While peil.Next(1&, pidlEnum, pcl) = S_OK
    '       SHCreateItemFromIDList ILCombine(pidlPar, pidlEnum), IID_IShellItem, siChild
    If (pEnum Is Nothing) = False Then
        bFilling = True
        tc1 = GetTickCount()
        Do While pEnum.Next(1&, siChild, pcl) = S_OK
            lpName = 0: sName = "": lpFull = 0: sFull = "": lpIcon = 0&: lpIconOvr = 0&: lAtr = 0&: bFolder = False: bZip = False: fDisable = 0&
            siChild.GetAttributes SFGAO_CAPABILITYMASK Or SFGAO_CONTENTSMASK Or SFGAO_PKEYSFGAOMASK Or SFGAO_STORAGECAPMASK Or SFGAO_COMPRESSED Or SFGAO_ENCRYPTED Or SFGAO_SHARE Or SFGAO_HIDDEN Or SFGAO_SYSTEM, lAtr
            If lAtr = 0& Then
                'Quick Access for one pulls this shit
                Set si2 = siChild
                si2.GetUInt32 PKEY_SFGAOFlags, lAtr
            End If
            If ((lAtr And SFGAO_FOLDER) = SFGAO_FOLDER) Or (mShowFiles = True) Or (bFav = True) Then
                If (((mShowFiles = False) And ((mExpandZip = False) And (lAtr And SFGAO_STREAM) = 0&) Or (mExpandZip = True))) Or ((bFav = True) And (bQkAc = False)) Or (mShowFiles = True) Then 'exlude .zip/.cab
                    If (bFav = True) And (bQkAc = False) Then
                        If (lAtr And SFGAO_LINK) = 0& Then GoTo nxt
                    End If
                    siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                    sNameFull = LPWSTRtoStr(lpNameFull)
                    If (m_HiddenPref = STHP_UseExplorer) Then
                        If (mHPInExp = False) And ((lAtr And SFGAO_HIDDEN) = SFGAO_HIDDEN) Then GoTo nxt
                    Else
                        If (m_HiddenPref = STHP_AlwaysHide) And ((lAtr And SFGAO_HIDDEN) = SFGAO_HIDDEN) Then GoTo nxt
                    End If
                    If (m_SuperHiddenPref = STSHP_UseExplorer) Then
                        If (mSHPInExp = False) And (((lAtr And SFGAO_HIDDEN) = SFGAO_HIDDEN) And ((lAtr And SFGAO_SYSTEM) = SFGAO_SYSTEM)) Then GoTo nxt
                    Else
                        If (m_SuperHiddenPref = STSHP_AlwaysHide) And (((lAtr And SFGAO_HIDDEN) = SFGAO_HIDDEN) And ((lAtr And SFGAO_SYSTEM) = SFGAO_SYSTEM)) Then GoTo nxt
                    End If

                    If (lAtr And SFGAO_FOLDER) = SFGAO_FOLDER Then
                        bFolder = True
                        If (bFav = True) And (bQkAc = False) Then GoTo nxt
                        If (lAtr And SFGAO_STREAM) = SFGAO_STREAM Then
                            bZip = True
                        End If
                    End If
                   If bFav Then
                        DebugAppend "QA->" & sNameFull & " attr=" & dbg_sfgao_tostring(lAtr)
                    End If
                        
                    If (mFilter <> "*.*") And (mFilter <> "") Then
                        If bFav = False Then
                            If bFolder Then
                                If mFilterFilesOnly = False Then
                                    If InStr(mFilter, ";") Then
                                        If PathMatchSpecExW(StrPtr(sNameFull), StrPtr(mFilter), PMSF_MULTIPLE) = 0& Then GoTo nxt
                                    Else
                                        If PathMatchSpecW(StrPtr(sNameFull), StrPtr(mFilter)) = 0& Then GoTo nxt
                                    End If
                                End If
                            Else
                                If InStr(mFilter, ";") Then
                                    If PathMatchSpecExW(StrPtr(sNameFull), StrPtr(mFilter), PMSF_MULTIPLE) = 0& Then GoTo nxt
                                Else
                                    If PathMatchSpecW(StrPtr(sNameFull), StrPtr(mFilter)) = 0& Then GoTo nxt
                                End If
                            End If
                        End If
                    End If
                        
                    nCur = nCur + 1
                    ReDim Preserve TVEntries(nCur)
                    fSubFolder = 1
                    tVI.Mask = TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE Or TVIF_PARAM Or TVIF_STATEEX 'Or TVIF_STATE
                    If (((lAtr And SFGAO_FILESYSANCESTOR) = False) And ((lAtr And SFGAO_FILESYSTEM) = False)) Or ((lAtr And SFGAO_NONENUMERATED) = SFGAO_NONENUMERATED) Then
'                        If (lAtr And SFGAO_DROPTARGET) = 0& Then
'                            fDisable = 1&
'                            TVEntries(nCur).bDisabled = True
'                        End If
                    End If
                    If fDisable = 0& Then
                        If bFav = False Then
                            If (bZip = False) Or ((bZip = True) And (mNeverExpandZip = False)) Then
                                If (lAtr And SFGAO_HASSUBFOLDER) = SFGAO_HASSUBFOLDER Then
                                    If (TVEntries(nCur).bZip = False) Or ((TVEntries(nCur).bZip = True) And (mExpandZip = True)) Then
                                        tVI.cChildren = 1
                                        tVI.Mask = tVI.Mask Or TVIF_CHILDREN
                                    End If
                                Else
                                    If (mShowFiles = True) Then
                                        If bFolder = True Then
                                            If FolderIsEmpty(siChild) = False Then
                                                tVI.cChildren = 1
                                                tVI.Mask = tVI.Mask Or TVIF_CHILDREN
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                    
'                    DebugAppend sName & " atr=" & dbg_sfgao_tostring(lAtr)
                    siChild.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
                    sFull = LPWSTRtoStr(lpFull)
                    siChild.GetDisplayName SIGDN_NORMALDISPLAY, lpName
                    sName = LPWSTRtoStr(lpName)
                    If m_ForceExt = STEP_AlwaysShow Then
                        ' siChild.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                        ' sNameFull = LPWSTRtoStr(lpNameFull)
                        If (Left$(sNameFull, 3) <> "::{") And (Left$(sNameFull, 5) <> "uuid:") And ((InStr(sNameFull, "\?\usb#")) = 0) And (Left$(sNameFull, 7) <> "usb#vid") Then
                            sName = sNameFull
                        End If
                    End If
                    If (mShowFiles = True) And (mExpandZip = False) Then
                        If (bFolder = True) And (bZip = True) Then
                            bFolder = False
                        End If
                    End If
                    TVEntries(nCur).sFullPath = sFull
                    TVEntries(nCur).sName = sName
                    TVEntries(nCur).bFolder = bFolder
                    TVEntries(nCur).sParentFull = StrGetPath(TVEntries(nCur).sFullPath)
                    TVEntries(nCur).sNameFull = sNameFull
                    TVEntries(nCur).bZip = bZip
                    TVEntries(nCur).dwAttrib = lAtr
                    If (lAtr And SFGAO_DROPTARGET) = SFGAO_DROPTARGET Then
                        TVEntries(nCur).bDropTarget = True
                    End If
                    Set upi = siChild
                    upi.GetParentAndItem pidlPar, psf, pidlRel
'                    Set si2Child = siChild
                    On Error Resume Next
                    If (psf Is Nothing) = False Then
            ''            DebugAppend "psf is valid, set pIcon with pidlRel=" & pidlRel & ",pidl=" & pidlPar
            '            Set pIcon = psf
                        Set pUnk = psf
                        hr = pUnk.QueryInterface(IID_IShellIcon, pIcon)
'                        DebugAppend "QueryInterface=0x" & Hex$(hr)
                        If hr = S_OK Then
                            pIcon.GetIconOf pidlRel, GIL_FORSHELL, lpIcon
                            Debug.Print "IShellIcon=" & lpIcon & " for " & sName
                        Else
                          Dim pidlcb As LongPtr
                          pidlcb = ILCombine(pidlPar, pidlRel)
            '              DebugAppend "pidlcb=" & pidlcb
                          lpIcon = GetFileIconIndexPIDL(pidlcb, SHGFI_SMALLICON)
                          DebugAppend "lpIcon on fallback=" & lpIcon
                        End If
                        If lpIcon = -1 Then lpIcon = 0
                    End If
                    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
                    EnsureOverlay lpIconOvr
                    On Error GoTo e0
                    TVEntries(nCur).nIcon = TranslateIcon(lpIcon, siChild, lAtr, pidlPar, TVEntries(nCur).pidlFQ, mIconSize * m_ScaleX, mIconSize * m_ScaleY, pidlRel)
                    TVEntries(nCur).nOverlay = lpIconOvr
                    TVEntries(nCur).pidlFQPar = pidlPar
                    TVEntries(nCur).pidlRel = pidlRel
                    TVEntries(nCur).hParentNode = hitemParent
                    If fLoad Then
                        TVEntries(nCur).bIsDefItem = True
                    End If
                    If (lAtr And SFGAO_LINK) = SFGAO_LINK Then
                        TVEntries(nCur).bLink = True
                        TVEntries(nCur).sLinkTarget = GetLinkTarget(siChild)
                        If TVEntries(nCur).sLinkTarget = "" Then TVEntries(nCur).LinkPIDL = GetLinkTargetPIDL(siChild)
                        If PathIsDirectoryW(StrPtr(TVEntries(nCur).sLinkTarget)) Then
                            TVEntries(nCur).bLinkIsFolder = True
                        End If
                        tVI.Mask = tVI.Mask Or TVIF_STATE
                    End If
                    If bFav Then
                        TVEntries(nCur).bFavorite = True
                    End If
                    tVI.cchTextMax = Len(TVEntries(nCur).sName)
                    tVI.pszText = StrPtr(TVEntries(nCur).sName)
                    tVI.iImage = TVEntries(nCur).nIcon
                    tVI.iSelectedImage = TVEntries(nCur).nIcon
                    tVI.lParam = nCur
                    If lpIconOvr > -1 Then
                        tVI.Mask = tVI.Mask Or TVIF_STATE
                        tVI.StateMask = TVIS_OVERLAYMASK
                        tVI.State = INDEXTOOVERLAYMASK(lpIconOvr)
                    End If
                    tvins.hParent = hitemParent
                    tvins.hInsertAfter = hitemPrev
                    tvins.Item = tVI
                    
                    hitemPrev = SendMessage(hTVD, TVM_INSERTITEMW, 0&, tvins)
                    TVEntries(nCur).hNode = hitemPrev
                    nCount = nCount + 1
                    
                    If bFav Or ((bFolder = True) And (mShowOnlyFileCheckbox = True) And (mShowFiles = True)) Then
                        TreeView_SetCheckStateEx hTVD, hitemPrev, 0
                        Debug.Print "ForceCheckState0 " & TVEntries(nCur).sName
                    Else
                        Debug.Print "NOForceCheckState0 " & TVEntries(nCur).sName & ", bFolder=" & bFolder
                        If TreeView_GetCheckState(hTVD, hitemParent) = 2 Then
                           If mAutocheck = True Then
                             TreeView_SetCheckState hTVD, hitemPrev, 1
                            End If
                        End If
                    End If
                    If fDisable Then
                        DebugAppend "TVExpandFolder->Disable " & TVEntries(nCur).sName & ",atr=" & dbg_sfgao_tostring(lAtr)
                        TreeView_SetItemStateEx hTVD, hitemPrev, TVIS_EX_DISABLED
'                        TreeView_SetCheckStateEx hTVD, hitemPrev, 3
                    End If
                End If
            End If
nxt:
        Loop
        tc2 = GetTickCount()
        DebugAppend "TVExpandFolder added " & nCount & " items in " & (tc2 - tc1) & "ms", 2
        bFilling = False
        Set psfCur = psf
    End If
End If
If ppidlp Then CoTaskMemFree ppidlp
If fSubFolder = 0& Then 'false alarm; doesn't actually have em
    tVI.hItem = hitemParent
    tVI.Mask = TVIF_CHILDREN
    Call SendMessage(hTVD, TVM_GETITEM, 0, tVI)
    tVI.cChildren = 0
    Call SendMessage(hTVD, TVM_SETITEM, 0, tVI)
End If
Call Hourglass(False)
SetFocusAPI UserControl.ContainerHwnd
SetFocusAPI hTVD
                    
'<EhFooter>
Exit Sub

e0:
    DebugAppend "ucShellTree.TVExpandFolder->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Sub

Private Function GetIndexFromNode(hNode As LongPtr) As Long
Dim i As Long
GetIndexFromNode = -1
For i = 0 To UBound(TVEntries)
    If TVEntries(i).hNode = hNode Then
        GetIndexFromNode = i
        Exit Function
    End If
Next i
End Function

Private Function GetIndexFromPath(sPath As String) As Long
Dim i As Long
GetIndexFromPath = -1
For i = 0 To UBound(TVEntries)
    If TVEntries(i).sFullPath = sPath Then
        GetIndexFromPath = i
        Exit Function
    End If
Next i
End Function

Private Function GetIndexFromPathND(sPath As String) As Long
Dim i As Long
GetIndexFromPathND = -1
For i = 0 To UBound(TVEntries)
    If TVEntries(i).sFullPath = sPath Then
        If TVEntries(i).bDeleted = False Then
            GetIndexFromPathND = i
            Exit Function
        End If
    End If
Next i
End Function

Private Function GetSelectedTVItem(hTV As LongPtr, tVI As TVITEM) As LongPtr
    tVI.hItem = TreeView_GetSelection(hTV)
    tVI.Mask = TVIF_TEXT Or TVIF_PARAM Or TVIF_IMAGE Or TVIF_STATE Or TVIF_HANDLE Or TVIF_SELECTEDIMAGE Or TVIF_CHILDREN
    tVI.pszText = StrPtr(String$(MAX_PATH, 0))
    tVI.cchTextMax = MAX_PATH
    GetSelectedTVItem = TreeView_GetItem(hTV, tVI)
End Function

Private Function LoWord(ByVal DWord As Long) As Integer
If DWord And &H8000& Then
    LoWord = DWord Or &HFFFF0000
Else
    LoWord = DWord And &HFFFF&
End If
End Function

Private Function CreateTreeView(hwndParent As LongPtr, _
                                                    IID As Long, _
                                                    dwStyle As Long, _
                                                    dwExStyle As Long) As LongPtr
  Dim RC As RECT ' parent client rect
  Call GetClientRect(hwndParent, RC)
  ' Create the TreeView control.
  DebugAppend "CreateTreeView->cx=" & RC.Right & ",cy=" & RC.Bottom
  CreateTreeView = CreateWindowEx(dwExStyle, StrPtr(WC_TREEVIEW), StrPtr(""), _
                                                dwStyle, 0, 0, RC.Right, RC.Bottom, _
                                            hwndParent, IID, App.hInstance, 0)
    If CreateTreeView = 0 Then
        DebugAppend "CreateTreeView->CreateWindowEx failed, error 0x" & Hex$(Err.LastDllError)
    End If
End Function

Private Sub InitTV()
Dim dwStyle As ucst_TV_Styles '
Dim dwExStyle As WindowStylesEx
'If mBorder Then 'The old single border option in case you want to restore it
'    dwStyle = dwStyle Or WS_BORDER
'End If          'The old Property Get/Let is there and commented out as well.
Select Case mBorder
    Case STBS_Standard
        dwStyle = dwStyle Or WS_BORDER
    Case STBS_Thick
        dwStyle = dwStyle Or WS_BORDER
        dwExStyle = WS_EX_CLIENTEDGE
    Case STBS_Thicker
        dwStyle = dwStyle Or WS_BORDER Or WS_THICKFRAME
        dwExStyle = WS_EX_CLIENTEDGE
End Select
If mShowSelAlw Then
    dwStyle = dwStyle Or TVS_SHOWSELALWAYS
End If
If m_TrackSel Then
    dwStyle = dwStyle Or TVS_TRACKSELECT
End If
If mLabelEdit Then
    dwStyle = dwStyle Or TVS_EDITLABELS
End If
If mHasButtons Then
    dwStyle = dwStyle Or TVS_HASBUTTONS
End If
If mShowLines Then
    dwStyle = dwStyle Or TVS_HASLINES
End If
If mSingleExpand Then
    dwStyle = dwStyle Or TVS_SINGLEEXPAND
End If
If mHScroll = False Then
    dwStyle = dwStyle Or TVS_NOHSCROLL
End If
If mFullRowSelect Then
    dwStyle = dwStyle Or TVS_FULLROWSELECT
End If
If ((mCheckboxes = True) And (mAutocheck = False) And (mExCheckboxes = False)) Or ((mCheckboxes = True) And (IsComCtl6 = False)) Then
    dwStyle = dwStyle Or TVS_CHECKBOXES
End If
If (mInfoTipOnFiles = True) Or (mInfoTipOnFolders = True) Then
    dwStyle = dwStyle Or TVS_INFOTIP
End If

  hTVD = CreateTreeView(UserControl.hWnd, _
                                              IDD_TREEVIEW, _
                                              dwStyle Or _
                                              WS_TABSTOP Or WS_VISIBLE Or WS_CHILD, _
                                              dwExStyle)

m_hWnd = hTVD
Set Me.Font = PropFont
Me.BackColor = clrBack
Me.ForeColor = clrFore

If Ambient.UserMode Then
    DebugAppend "Subclass TV, h=" & hTVD
    'Subclass hTVD, AddressOf ShellTreeSubclassProc, hTVD, ObjPtr(Me)
    Subclass hTVD, AddressOf ShellTreeSubclassProc, hTVD, ObjPtr(Me)
End If

DebugAppend "frmTV.InitTV::hWnd=" & hTVD, 3
Dim dwStyleEx As ucst_TV_Ex_Styles

dwStyleEx = CLng(SendMessage(hTVD, TVM_GETEXTENDEDSTYLE, 0, ByVal 0&))
dwStyleEx = TVS_EX_DOUBLEBUFFER Or &H1000
If mFadeExpandos Then
    dwStyleEx = dwStyleEx Or TVS_EX_FADEINOUTEXPANDOS
End If
If mMultiSel Then
    dwStyleEx = dwStyleEx Or TVS_EX_MULTISELECT
End If
If mNoIndState Then
    dwStyleEx = dwStyleEx Or TVS_EX_NOINDENTSTATE
End If
If mAutoHS Then
    dwStyleEx = dwStyleEx Or TVS_EX_AUTOHSCROLL
End If
If IsComCtl6 Then
    If (mCheckboxes = True) And (mAutocheck = True) Then
        dwStyleEx = dwStyleEx Or TVS_EX_PARTIALCHECKBOXES
    End If
    If (mCheckboxes = True) And (mExCheckboxes = True) Then
        DebugAppend "SET TVS_EX_ECB"
        dwStyleEx = dwStyleEx Or TVS_EX_EXCLUSIONCHECKBOXES
    End If
End If
Call SendMessage(hTVD, TVM_SETEXTENDEDSTYLE, dwStyleEx, ByVal dwStyleEx)

If mIndent < 0& Then mIndent = mDefIndent
Call SendMessage(hTVD, TVM_SETINDENT, mIndent, ByVal 0)

If mExplorerStyle Then
    Dim sTheme As String
    sTheme = "explorer"
    Call SetWindowTheme(hTVD, StrPtr(sTheme), 0)
End If

InitImageLists
Call SendMessage(hTVD, TVM_SETIMAGELIST, TVSIL_NORMAL, ByVal himlTV)

'TreeView_SetImageList hTVD, himlTVCheck, TVSIL_STATE 'if you want to go back to custom checks

End Sub

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

Private Function TrimNullW(startstr As String) As String

   TrimNullW = Left$(startstr, lstrlenW(ByVal StrPtr(startstr)))
   
End Function

Private Function Attach(hwnd As LongPtr) As Long
If bRegDD = False Then
    Attach = RegisterDragDrop(hwnd, Me)
    bRegDD = True
End If
End Function

Private Function Detach() As Long
'There's an appcrash if revoke is called on an unregistered window
If bRegDD Then
    If RegisterDragDrop(m_hWnd, Me) = DRAGDROP_E_ALREADYREGISTERED Then
        Detach = RevokeDragDrop(m_hWnd)
        bRegDD = False
    End If
End If
End Function

Private Function FolderIsEmpty(sItem As IShellItem) As Boolean
Dim pEnum As IEnumShellItems
Dim pc As Long
Dim sTmp As IShellItem
sItem.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, pEnum
If (pEnum Is Nothing) Then
    FolderIsEmpty = True
    Exit Function
Else
    
    If (pEnum.Next(1&, sTmp, pc) <> S_OK) Then
        FolderIsEmpty = True
        Exit Function
    End If
End If
    
End Function

Private Function GenerateInfoTip(iItem As LongPtr) As String
'DebugAppend "GenerateInfoTip item=" & iItem & ",name=" & TVEntries(iItem).sName
Dim si As IShellItem
Dim sTip As String
Dim ppidlp As LongPtr
On Error GoTo e0

SHCreateItemFromParsingName StrPtr(TVEntries(iItem).sFullPath), Nothing, IID_IShellItem, si
If (si Is Nothing) Then
    DebugAppend "GenerateInfoTip->ShellItem failed, trying to load from pidls...", 3
    If (TVEntries(iItem).pidlFQPar <> 0&) And (TVEntries(iItem).pidlRel <> 0&) Then
        ppidlp = ILCombine(TVEntries(iItem).pidlFQPar, TVEntries(iItem).pidlRel)
        SHCreateItemFromIDList ppidlp, IID_IShellItem, si
        If (si Is Nothing) = False Then
            DebugAppend "GenerateInfoTip->LoadFromPidl->Success!", 3
        Else
            DebugAppend "GenerateInfoTip->LoadFromPidl->Failed.", 3
        End If
    Else
        DebugAppend "GenerateInfoTip->LoadFromPidl->Parent or child pidl not set.", 3
    End If
    If ppidlp Then CoTaskMemFree ppidlp
End If

If (si Is Nothing = False) Then
    Dim pqi As IQueryInfo
    si.BindToHandler 0&, BHID_SFUIObject, IID_IQueryInfo, pqi
    If (pqi Is Nothing) = False Then
        Dim lpTip As LongPtr, sQITip As String
        pqi.GetInfoTip QITIPF_USESLOWTIP, lpTip
        sQITip = LPWSTRtoStr(lpTip)
'        DebugAppend "IQueryInfo.Slo=" & sQITip
        GenerateInfoTip = sQITip
        Exit Function
    Else
        DebugAppend "Failed to get IQueryInfo"
    End If
    
    Dim lpp As Long
    Dim si2p As IShellItem2
    Dim pl As IPropertyDescriptionList
    Dim pd As IPropertyDescription
    Dim lpn As LongPtr, sPN As String
    
    Set si2p = si
    Dim pst As IPropertyStore
    si2p.GetPropertyDescriptionList PKEY_PropList_InfoTip, IID_IPropertyDescriptionList, pl
    If (pl Is Nothing) = False Then
        pl.GetCount lpp
    '    DebugAppend "InfoTip Cnt=" & lpp
        If lpp Then
            Dim stt As String
            si2p.GetPropertyStore GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pst
            If (pst Is Nothing) = False Then
    '            DebugAppend "PropsList=" & GetPropertyKeyDisplayString(pst, PKEY_PropList_InfoTip)
                'We could just parse that; but going through IPropertyDescriptionList automatically skips
                'fields where there's no data (an error is raised, hence the e1/resume next)GPS_DEFAULT Or
                On Error GoTo e1
                Dim i As Long
                For i = 0 To (lpp - 1)
                    pl.GetAt i, IID_IPropertyDescription, pd
                    If (pd Is Nothing) = False Then
                        stt = GetPropertyDisplayString(pst, pd)
                        If stt <> "" Then 'well, it used to generate an error??? then suddenly stopped 10 min later!?!?
                            pd.GetDisplayName lpn
                            sPN = LPWSTRtoStr(lpn)
                            stt = sPN & ": " & stt
                            If sTip = "" Then
                                sTip = stt
                            Else
                                sTip = sTip & vbCrLf & stt
                            End If
    '                        DebugAppend "Prop=" & stt
                            stt = ""
                        End If
                        Set pd = Nothing
                    Else
    '                    DebugAppend "Prop=(missing)"
                    End If
                Next i
                Set pst = Nothing
            End If
        Else
            DebugAppend "lpp=" & lpp
        End If
    Else
        DebugAppend "No proplist"
    End If
Else
    DebugAppend "No IShellItem"
End If
GenerateInfoTip = sTip
Exit Function
e0:
DebugAppend "GenerateInfoTip->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
Exit Function
e1:
DebugAppend "GenerateInfoTip->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
Resume Next
End Function

Private Function GetPropertyDisplayString(pps As IPropertyStore, ppd As IPropertyDescription, Optional bFixChars As Boolean = True) As String
'Same as above if you already have the IPropertyDescription (caller is responsible for freeing it too)
Dim lpsz As LongPtr
On Error GoTo e0
If ((pps Is Nothing) = False) And ((ppd Is Nothing) = False) Then
    PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
    SysReAllocString VarPtr(GetPropertyDisplayString), lpsz
    CoTaskMemFree lpsz
    If bFixChars Then
        GetPropertyDisplayString = Replace$(GetPropertyDisplayString, ChrW$(&H202A), "")
        GetPropertyDisplayString = Replace$(GetPropertyDisplayString, ChrW$(&H202C), "")
        GetPropertyDisplayString = Replace$(GetPropertyDisplayString, ChrW$(&H200E), "")
        GetPropertyDisplayString = Replace$(GetPropertyDisplayString, ChrW$(&H200F), "")
    End If
Else
    DebugAppend "GetPropertyDisplayString.Error->PropertyStore or PropertyDescription is not set."
    
End If
Exit Function
e0:
DebugAppend "GetPropertyDisplayString.Error->" & Err.Description & ", 0x" & Hex$(Err.Number)
End Function

Private Function GetPreferredEffect(pDataObj As IDataObject) As DROPEFFECTS
Dim tSTG As STGMEDIUM
Dim tFMT As FORMATETC
Dim lpGlobal As LongPtr
Dim hGlobal As LongPtr
Dim lEf As Long

    tFMT.cfFormat = CF_PREFERREDDROPEFFECT
    tFMT.dwAspect = DVASPECT_CONTENT
    tFMT.lIndex = -1
    tFMT.tymed = TYMED_HGLOBAL

    pDataObj.GetData tFMT, tSTG
    lpGlobal = GlobalLock(tSTG.data)
    CopyMemory lEf, ByVal lpGlobal, LenB(lEf)
    Call GlobalUnlock(tSTG.data)
    ReleaseStgMedium tSTG
    
    GetPreferredEffect = lEf
End Function

Private Sub TVDoPaste()
'Handle a paste command
Dim pdo As IDataObject
Dim lEfct As DROPEFFECTS
Dim siDrop As IShellItem
On Error GoTo e0
OleGetClipboard pdo
If (pdo Is Nothing) Then Exit Sub
If DataObjSupportsFormat(pdo, CF_HDROP) Then 'clipboard has files for us
    If GetPreferredEffect(pdo) = DROPEFFECT_MOVE Then
        DebugAppend "Paste as move"
        lEfct = DROPEFFECT_MOVE
    Else
        lEfct = DROPEFFECT_COPY
    End If
    If ((siSelected Is Nothing) = False) Then
        Dim lAtr As SFGAOF
        siSelected.GetAttributes SFGAO_FOLDER, lAtr
        If (lAtr And SFGAO_FOLDER) = SFGAO_FOLDER Then
            Set siDrop = siSelected
        End If
    End If
 
    Dim pDT As IDropTarget
    siDrop.BindToHandler 0&, BHID_SFUIObject, IID_IDropTarget, pDT
    If (pDT Is Nothing) = False Then
        Dim lpName As LongPtr
        Dim pt0 As POINT
        siDrop.GetDisplayName SIGDN_NORMALDISPLAY, lpName
        DebugAppend "Go for paste on " & LPWSTRtoStr(lpName)
        pDT.DragEnter pdo, MK_LBUTTON, pt0, lEfct
        pDT.Drop pdo, MK_LBUTTON, pt0, lEfct
    Else
        Beep
        DebugAppend "Fail DropTarget"
    End If
 
End If
Exit Sub
e0:
    DebugAppend "TVDoPaste.Error->" & Err.Description & ", 0x" & Hex$(Err.Number)
End Sub

Private Sub TVCutSelected()
Dim si As LongPtr

si = TreeView_GetSelection(hTVD)
TreeView_SetItemState hTVD, si, TVIS_CUT, TVIS_CUT
End Sub

Private Function ShowShellContextMenu(lp As LongPtr) As Long
Dim cnt As Long
If m_EnableShellMenu = False Then Exit Function
'Cnt = SendMessage(hTVD, TVM_GETSELECTEDCOUNT, 0&, ByVal 0&)
If lp < 1 Then
'    ShowViewMenu True
    Exit Function
End If
'If cnt = 0 Then Exit Function
Dim i As Long
'Dim lp As Long
Dim apidl() As LongPtr
Dim cpidl As Long
Dim pcm As IContextMenu
Dim cmi As CMINVOKECOMMANDINFO
Dim PT As POINT
Dim idCmd As Long
Dim hMenu As LongPtr
Dim uFlag As QueryContextMenuFlags
Dim mii As MENUITEMINFOW
Dim psfPar As IShellFolder
Dim psi As IShellItem
Dim ppidlp As LongPtr
Const sSel As String = "Select"

ReDim apidl(0)

apidl(cpidl) = TVEntries(lp).pidlRel
cpidl = cpidl + 1

Dim upi As IParentAndItem
Dim pidl As LongPtr, pidlRel As LongPtr
DebugAppend "ShowShellContextMenu->Parse to isi " & TVEntries(lp).sFullPath
SHCreateItemFromParsingName StrPtr(TVEntries(lp).sFullPath), Nothing, IID_IShellItem, psi
If (psi Is Nothing) Then
    DebugAppend "ShowShellContextMenu->ShellItem failed, trying to load from pidls...", 3
    If (TVEntries(lp).pidlFQPar <> 0&) And (TVEntries(lp).pidlRel <> 0&) Then
        ppidlp = ILCombine(TVEntries(lp).pidlFQPar, TVEntries(lp).pidlRel)
        SHCreateItemFromIDList ppidlp, IID_IShellItem, psi
        If (psi Is Nothing) = False Then
            DebugAppend "ShowShellContextMenu::LoadFromPidl->Success!", 3
        Else
            DebugAppend "ShowShellContextMenu::LoadFromPidl->Failed.", 3
        End If
    Else
        DebugAppend "ShowShellContextMenu::LoadFromPidl->Parent or child pidl not set.", 3
    End If
    If ppidlp Then CoTaskMemFree ppidlp
End If
If (psi Is Nothing) = False Then
    Set upi = psi
Else
    DebugAppend "ShowShellContextMenu->Failed to get IShellItem"
    Exit Function
End If
    
If (upi Is Nothing) = False Then
    upi.GetParentAndItem pidl, psfPar, pidlRel
Else
    DebugAppend "ShowShellContextMenu->Failed to get ParentAndItemCMF_EXPLORE Or "
    Exit Function
End If

psfPar.GetUIObjectOf hTVD, cpidl, apidl(0), IID_IContextMenu, 0&, pcm
uFlag = CMF_NODEFAULT Or CMF_CANRENAME Or CMF_ITEMMENU

If mAlwaysShowExtVerbs Then
    uFlag = uFlag Or CMF_EXTENDEDVERBS
Else
    If (GetKeyState(VK_SHIFT) And &H80) = &H80 Then
        uFlag = uFlag Or CMF_EXTENDEDVERBS
    End If
End If
    
If (pcm Is Nothing) = False Then
    hMenu = CreatePopupMenu()
    Dim pUnk As IUnknownUnrestricted
    Set pUnk = pcm
    pUnk.QueryInterface IID_IContextMenu2, ICtxMenu2
    pUnk.QueryInterface IID_IContextMenu3, ICtxMenu3
    If (ICtxMenu3 Is Nothing) = False Then
        ICtxMenu3.QueryContextMenu hMenu, 0&, 1&, &H7FFF, uFlag
    Else
        If (ICtxMenu2 Is Nothing) = False Then
            ICtxMenu2.QueryContextMenu hMenu, 0&, 1&, &H7FFF, uFlag
        Else
            pcm.QueryContextMenu hMenu, 0&, 1&, &H7FFF, uFlag
        End If
    End If
    mii.cbSize = LenB(mii)
    mii.fMask = MIIM_TYPE
    mii.fType = MFT_SEPARATOR
    InsertMenuItemW hMenu, 0&, True, mii
    
    mii.fMask = MIIM_STRING Or MIIM_ID Or MIIM_STATE
    mii.wID = wIDSel
    mii.fState = MFS_DEFAULT
    mii.cch = Len(sSel)
    mii.dwTypeData = StrPtr(sSel)
    InsertMenuItemW hMenu, 0&, True, mii
     
    Call GetCursorPos(PT)
    
    idCmd = TrackPopupMenu(hMenu, TPM_LEFTBUTTON Or TPM_RIGHTBUTTON Or TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_HORIZONTAL Or TPM_RETURNCMD, PT.x, PT.y, 0&, hTVD, 0&)
   
    If idCmd Then
        If idCmd = wIDSel Then
            RaiseEvent ItemSelect(TVEntries(lp).sName, TVEntries(lp).sFullPath, TVEntries(lp).bFolder, TVEntries(lp).hNode)
            RaiseEvent ItemSelectByShellItem(psi, TVEntries(lp).sName, TVEntries(lp).sFullPath, TVEntries(lp).bFolder, TVEntries(lp).hNode)
        Else
            Dim sVerb As String
            sVerb = String$(MAX_PATH, 0&)
            On Error Resume Next
            pcm.GetCommandString idCmd - 1, GCS_VERBW, 0&, StrPtr(sVerb), Len(sVerb)
            sVerb = LCase$(TrimNullW(sVerb))
            DebugAppend "ShellContextMenu->Verb=" & sVerb
            On Error GoTo e0
            If sVerb = "rename" Then
                DebugAppend "ShellContextMenu->Rename"
                Call SendMessage(hTVD, TVM_EDITLABELW, 0&, ByVal TVEntries(lp).hNode)
            Else
                With cmi
                    .cbSize = LenB(cmi)
                    .hwnd = hTVD
                    .lpVerb = idCmd - 1 ' MAKEINTRESOURCE(idCmd-1);
                    .nShow = SW_SHOWNORMAL
                End With
                If (ICtxMenu2 Is Nothing) = False Then
                    ICtxMenu2.InvokeCommand VarPtr(cmi)
                Else
                    pcm.InvokeCommand VarPtr(cmi)
                End If
                If sVerb = "cut" Then TVCutSelected
            End If
        End If
    End If
Else
    DebugAppend "ShowShellContextMenu->Failed to get IContextMenu"
End If
DestroyMenu hMenu
Set ICtxMenu2 = Nothing
Set pcm = Nothing
Exit Function
e0:
DebugAppend "ShowShellContextMenu->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
End Function

Private Function StartNotify(hwnd As LongPtr, Optional pidlPath As LongPtr = 0) As LongPtr
  Dim tCNE As SHChangeNotifyEntry
  Dim pidl As LongPtr
  
  If (m_hSHNotify = 0) Then
        If pidlPath = 0 Then
'            Call SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pidl)
            tCNE.pidl = VarPtr(0) 'pidl '
        Else
            tCNE.pidl = pidlPath
        End If
      tCNE.fRecursive = 1
      
      m_hSHNotify = SHChangeNotifyRegister(hwnd, SHCNRF_ShellLevel Or SHCNRF_InterruptLevel Or SHCNRF_NewDelivery, SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, WM_SHNOTIFY, 1, tCNE)
      
      StartNotify = m_hSHNotify
        
  End If   ' (m_hSHNotify = 0)

End Function

Private Function StopNotify() As Boolean
StopNotify = SHChangeNotifyDeregister(m_hSHNotify)
End Function

Private Function dbg_LookUpSHCNE(uMsg As Long) As String

Select Case uMsg

Case &H1: dbg_LookUpSHCNE = "SHCNE_RENAMEITEM"
Case &H2: dbg_LookUpSHCNE = "SHCNE_CREATE"
Case &H4: dbg_LookUpSHCNE = "SHCNE_DELETE"
Case &H8: dbg_LookUpSHCNE = "SHCNE_MKDIR"
Case &H10: dbg_LookUpSHCNE = "SHCNE_RMDIR"
Case &H20: dbg_LookUpSHCNE = "SHCNE_MEDIAINSERTED"
Case &H40: dbg_LookUpSHCNE = "SHCNE_MEDIAREMOVED"
Case &H80: dbg_LookUpSHCNE = "SHCNE_DRIVEREMOVED"
Case &H100: dbg_LookUpSHCNE = "SHCNE_DRIVEADD"
Case &H200: dbg_LookUpSHCNE = "SHCNE_NETSHARE"
Case &H400: dbg_LookUpSHCNE = "SHCNE_NETUNSHARE"
Case &H800: dbg_LookUpSHCNE = "SHCNE_ATTRIBUTES"
Case &H1000: dbg_LookUpSHCNE = "SHCNE_UPDATEDIR"
Case &H2000: dbg_LookUpSHCNE = "SHCNE_UPDATEITEM"
Case &H4000: dbg_LookUpSHCNE = "SHCNE_SERVERDISCONNECT"
Case &H8000&: dbg_LookUpSHCNE = "SHCNE_UPDATEIMAGE"
Case &H10000: dbg_LookUpSHCNE = "SHCNE_DRIVEADDGUI"
Case &H20000: dbg_LookUpSHCNE = "SHCNE_RENAMEFOLDER"
Case &H40000: dbg_LookUpSHCNE = "SHCNE_FREESPACE"
Case &H4000000: dbg_LookUpSHCNE = "SHCNE_EXTENDED_EVENT"
Case &H8000000: dbg_LookUpSHCNE = "SHCNE_ASSOCCHANGED"
Case &H2381F: dbg_LookUpSHCNE = "SHCNE_DISKEVENTS"
Case &HC0581E0: dbg_LookUpSHCNE = "SHCNE_GLOBALEVENTS"
Case &H7FFFFFFF: dbg_LookUpSHCNE = "SHCNE_ALLEVENTS"
Case &H80000000: dbg_LookUpSHCNE = "SHCNE_INTERRUPT"

End Select
End Function

Private Function CalcRefreshData(ByRef sList() As String) As Boolean
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim i As Long, j As Long, k As Long
On Error GoTo e0
ReDim mRefreshPaths(0)

For i = 0 To UBound(TVEntries)
    If TVEntries(i).bDeleted = False Then
        If TVEntries(i).bFolder Then
            ReDim Preserve mRefreshPaths(j)
            mRefreshPaths(j) = TVEntries(i).sFullPath
            j = j + 1
        End If
    End If
Next i
PruneParentsFromRPL
Dim sTmp As String
Dim sExp() As String, nE As Long
Dim bA As Boolean
ReDim sExp(0)
For i = 0 To UBound(mRefreshPaths)
    bA = True
    For j = 0 To UBound(TVEntries)
        If TVEntries(j).sFullPath = mRefreshPaths(i) Then
            If (TVEntries(j).bIsDefItem = True) Then
                bA = False
            End If
        End If
    Next j
    sTmp = mRefreshPaths(i)
    For k = 0 To UBound(mRefreshPaths)
        If (Left$(mRefreshPaths(k), Len(sTmp)) = sTmp) And (Len(mRefreshPaths(k)) > Len(sTmp)) Then
            bA = False
        End If
    Next k
    If bA Then
        ReDim Preserve sExp(nE)
        sExp(nE) = mRefreshPaths(i)
        nE = nE + 1
    End If
Next i
Dim sExp2() As String, nE2 As Long
ReDim sExp2(0)
For i = 0 To UBound(sExp)
    bA = True
    sTmp = GetPathParent(sExp(i))
    For k = 0 To UBound(sExp)
        If (Left$(sExp(k), Len(sTmp)) = sTmp) And (i <> k) Then
            bA = False
        End If
    Next k
    If bA Then
        ReDim Preserve sExp2(nE2)
        sExp2(nE2) = sExp(i)
        nE2 = nE2 + 1
    End If
Next i
DebugAppend "Final set for re-expansion:"
dbg_printstrarr sExp2, False
If (UBound(sExp2) = 0&) And (sExp2(0) = "") Then
    CalcRefreshData = False
Else
    sList = sExp2
    CalcRefreshData = True
End If


'<EhFooter>
Exit Function

e0:
    DebugAppend "ucShellTree.CalcRefreshData->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Function

Private Sub PruneParentsFromRPL()
Dim sCur As String, sPar As String
Dim i As Long, j As Long, k As Long
Dim sOut() As String
Dim nOut As Long
On Error GoTo e0

For i = 0 To UBound(mRefreshPaths)
    sPar = GetPathParent(mRefreshPaths(i))
    If (PathHasChildInRPL(sPar) = False) Then
        mRefreshPaths(i) = ""
    End If
Next i
ReDim sOut(0)
For i = 0 To UBound(mRefreshPaths)
    If mRefreshPaths(i) <> "" Then
        ReDim Preserve sOut(nOut)
        sOut(nOut) = mRefreshPaths(i)
        nOut = nOut + 1
    End If
Next i
Dim aFn() As String, kF As Long
ReDim aFn(0)
For i = 0 To UBound(sOut)
    sPar = GetPathParent(sOut(i))
    For j = 0 To UBound(sOut)
        If j <> i Then
            If GetPathParent(sOut(j)) = sPar Then
                sOut(j) = ""
            End If
        End If
    Next j
Next i
ReDim aFn(0)
For i = 0 To UBound(sOut)
    If sOut(i) <> "" Then
        ReDim Preserve aFn(kF)
        aFn(kF) = sOut(i)
        kF = kF + 1
    End If
Next i
mRefreshPaths = aFn
Exit Sub
e0:
    DebugAppend "PruneParentsFromRPL.Error->" & Err.Description & "(0x" & Hex$(Err.Number) & ")"
End Sub

Private Function PathHasChildInRPL(sPath As String) As Boolean
Dim sCur As String, sPar As String
Dim i As Long, j As Long, k As Long

For i = 0 To UBound(mRefreshPaths)
    If Left$(mRefreshPaths(i), Len(sPath)) = sPath Then
        If Len(mRefreshPaths(i)) > Len(sPath) Then
            PathHasChildInRPL = True
            Exit Function
        End If
    End If
Next i

End Function

Private Function GetPathParent(sPath As String) As String
If Len(sPath) > 3 Then
    If InStr(sPath, "\") Then
        GetPathParent = Left$(sPath, InStrRev(sPath, "\") - 1)
    End If
End If
If Len(GetPathParent) = 2 Then
    GetPathParent = GetPathParent & "\"
End If
End Function



Private Sub ReadWindowsVersion()
'GetVersion[Ex] does not work with Win8 and above, so we'll go by kernel32 version
'GetFileVersionInfo does not work with some versions of Win10 and above.

Dim hMod As LongPtr
Dim hRes As LongPtr

hMod = LoadLibraryW(StrPtr("kernel32.dll"))
If hMod Then
    hRes = FindResourceW(hMod, StrPtr("#1"), RT_VERSION)
    If hRes Then
        Dim hGbl As LongPtr
        hGbl = LoadResource(hMod, hRes)
        If (hGbl) Then
            Dim lpRes As LongPtr
            lpRes = LockResource(hGbl)
            If lpRes Then
                Dim tVerInfo As VS_VERSIONINFO_FIXED_PORTION
                CopyMemory tVerInfo, ByVal lpRes, LenB(tVerInfo)
                If tVerInfo.Value.dwFileVersionMSh >= 6& Then
                    bIsWinVistaOrGreater = True
                    If tVerInfo.Value.dwFileVersionMSl >= 1& Then bIsWin7OrGreater = True
                    If tVerInfo.Value.dwFileVersionMSl >= 2& Then bIsWin8OrGreater = True
                    If (tVerInfo.Value.dwFileVersionMSl = 4&) Or (tVerInfo.Value.dwFileVersionMSh >= 10&) Then bIsWin10OrGreater = True
                End If
            End If
        End If
    End If
    FreeLibrary hMod
End If
Dim fWow64 As Long
IsWow64Process GetCurrentProcess(), fWow64
If fWow64 Then bIsWow64 = True
End Sub

Private Function LPWSTRtoStr(lPtr As LongPtr, Optional ByVal fFree As Boolean = True) As String
SysReAllocString VarPtr(LPWSTRtoStr), lPtr
If fFree Then
    Call CoTaskMemFree(lPtr)
End If
End Function


Private Sub pvCreate() 'Formerly in UserControl_Show()
'UserControl_Initialize
If hTVD <> 0& Then Exit Sub
DebugAppend "pvCreate"
Dim pidlDesktop As LongPtr
If Ambient.UserMode Then
    Subclass UserControl.hWnd, AddressOf ShellTreeSubclassProc, UserControl.hWnd, ObjPtr(Me)
End If
If mFavorites Then nCur = 1
InitTV
If Ambient.UserMode Then
    If m_NoWow64 Then
        DebugAppend "Disabling WOW64 Redirects"
        DisableWow64Redir
    End If
    
    EnumRoot
    
    SetFocusAPI hTVD
    
    If mSHCN Then StartNotify UserControl.hWnd
Else
    Dim tVI As TVITEM
    Dim tvins As TVINSERTSTRUCT
    Dim hRt As LongPtr, hItem As LongPtr
    
    tVI.Mask = TVIF_IMAGE Or TVIF_TEXT Or TVIF_CHILDREN
    tVI.cChildren = 1
    tVI.pszText = StrPtr(mVersionStr)
    tVI.cchTextMax = 22
    tVI.iImage = 1
    
    tvins.hInsertAfter = 0
    tvins.hParent = TVI_ROOT
    tvins.Item = tVI
    
    hRt = SendMessage(hTVD, TVM_INSERTITEMW, 0&, tvins)
    ReDim TVEntries(0)
    
End If
bLoadDone = True
If Ambient.UserMode Then
    If (mComputerAsRoot = False) And (bCustRt = False) And (mExpLib = True) Then
        Dim siLibRt As IShellItem
        SHGetKnownFolderItem FOLDERID_Libraries, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siLibRt
        If (siLibRt Is Nothing) = False Then
            OpenToItem siLibRt, True, False
        End If
    End If
    If (mComputerAsRoot = False) And (bCustRt = False) And (mExpComp = True) Then
        Dim siComp As IShellItem
        SHGetKnownFolderItem FOLDERID_ComputerFolder, KF_FLAG_DEFAULT, 0&, IID_IShellItem, siComp
        If (siComp Is Nothing) = False Then
            OpenToItem siComp, True, False
        End If
    End If
    
    RaiseEvent Initialized
End If


End Sub
Private Function OLEFontIsEqual(ByVal Font As StdFont, ByVal FontOther As StdFont) As Boolean
If Font Is Nothing Then
    If FontOther Is Nothing Then OLEFontIsEqual = True
ElseIf FontOther Is Nothing Then
    If Font Is Nothing Then OLEFontIsEqual = True
Else
    If Font.Name = FontOther.Name And Font.Size = FontOther.Size And Font.Charset = FontOther.Charset And Font.Weight = FontOther.Weight And _
    Font.Underline = FontOther.Underline And Font.Italic = FontOther.Italic And Font.Strikethrough = FontOther.Strikethrough Then
        OLEFontIsEqual = True
    End If
End If
End Function

Private Function CloneOLEFont(ByVal Font As IFont) As StdFont
Font.Clone CloneOLEFont
End Function

Private Function GDIFontFromOLEFont(ByVal Font As IFont) As Long
GDIFontFromOLEFont = Font.hFont
End Function

Private Function ImageList_AddIcon(himl As LongPtr, hIcon As LongPtr) As Long
  ImageList_AddIcon = ImageList_ReplaceIcon(himl, -1, hIcon)
End Function

Private Sub DisableWow64Redir()
If bIsWow64 = False Then Exit Sub
On Error Resume Next
Wow64DisableWow64FsRedirection lWow64Data
On Error GoTo 0
End Sub
Private Sub RevertWow64Redir()
If bIsWow64 = False Then Exit Sub
On Error Resume Next
Wow64RevertWow64FsRedirection lWow64Data
On Error GoTo 0
End Sub

Private Function AddBackslash(s As String) As String

   If Len(s) > 0 Then
      If Right$(s, 1) <> "\" Then
         AddBackslash = s & "\"
      Else
         AddBackslash = s
      End If
   Else
      AddBackslash = "\"
   End If

End Function

Private Sub FastDoEvents()
    Dim uMsg As MSG
    '
    Do While PeekMessage(uMsg, 0&, 0&, 0&, PM_REMOVE)   ' Reads and deletes message from queue.
        TranslateMessage uMsg                           ' Translates virtual-key messages into character messages.
        DispatchMessage uMsg                            ' Dispatches a message to a window procedure.
    Loop
End Sub

Private Function ComCtlVersion() As Long
Dim tVI As DLLVERSIONINFO
On Error Resume Next
tVI.cbSize = LenB(tVI)
If DllGetVersion(tVI) = S_OK Then ComCtlVersion = tVI.dwMajor
End Function

Private Sub HandleShellNotify(pidl1 As LongPtr, pidl2 As LongPtr, lEvent As SHCN_Events)
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
'if (levent =

Dim siItem1 As IShellItem
Dim szItem1 As String
Dim lpName As LongPtr
Dim siItem2 As IShellItem
Dim szItem2 As String
Dim lIdx As Long, lIdx2 As Long
Dim siPar As IShellItem
Dim lpPar As LongPtr, sPar As String
Dim hNode As LongPtr, hNodePar As LongPtr
Dim lpi1 As LongPtr, lpi2 As LongPtr
Dim tVI As TVITEM

If pidl1 Then
    SHCreateItemFromIDList pidl1, IID_IShellItem, siItem1
    If (siItem1 Is Nothing) = False Then
        siItem1.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpi1
        szItem1 = LPWSTRtoStr(lpi1)
    End If
End If
If pidl2 Then
    SHCreateItemFromIDList pidl2, IID_IShellItem, siItem2
    If (siItem2 Is Nothing) = False Then
        siItem2.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpi2
        szItem2 = LPWSTRtoStr(lpi2)
    End If
End If
DebugAppend "HandleShellNotify::code=" & dbg_LookUpSHCNE(lEvent) & ",itm1=" & szItem1 & ",itm2=" & szItem2
Select Case lEvent

    Case SHCNE_CREATE, SHCNE_MKDIR, SHCNE_DRIVEADD
DebugAppend "HandleShellNotify::code=" & dbg_LookUpSHCNE(lEvent) & ",itm1=" & szItem1 & ",itm2=" & szItem2
        siItem1.GetParent siPar
        If (siPar Is Nothing) = False Then
            If (mShowFiles = False) And (PathIsDirectoryW(StrPtr(szItem1)) = 0&) Then Exit Sub
            siPar.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpPar
            sPar = LPWSTRtoStr(lpPar)
            hNodePar = GetNodeByPath(sPar)
            hNode = GetNodeByPath(szItem1)
            If (hNode > 0) Then
                lIdx2 = GetIndexFromNode(hNode)
                If TVEntries(lIdx2).bDeleted = False Then Exit Sub 'item already exists and is visible
            End If
            DebugAppend "ADD hNodePar=" & hNodePar
            If hNodePar > 0 Then
                If (TreeView_GetItemState(hTVD, hNodePar, TVIS_EXPANDEDONCE) And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE Then
                    lIdx = GetIndexFromNode(hNodePar)
                    If TVEntries(lIdx).bDeleted = False Then
                        TVAddItem siItem1, hNodePar
                    End If
                Else
                    If (lEvent = SHCNE_MKDIR) Or ((lEvent = SHCNE_CREATE) And (mShowFiles = True)) Then
                        'Not adding it; but if it's a folder or file (when showing them), make sure the dest has children
                        tVI.Mask = TVIF_HANDLE Or TVIF_CHILDREN
                        tVI.hItem = hNodePar
                        TreeView_GetItem hTVD, tVI
                        
                        If tVI.cChildren = 0& Then
                            tVI.Mask = TVIF_CHILDREN
                            tVI.hItem = hNodePar
                            tVI.cChildren = 1&
                            TreeView_SetItem hTVD, tVI
                        End If
                    End If
                End If
            End If
        End If
        
    Case SHCNE_DELETE, SHCNE_RMDIR, SHCNE_DRIVEREMOVED
DebugAppend "HandleShellNotify::code=" & dbg_LookUpSHCNE(lEvent) & ",itm1=" & szItem1 & ",itm2=" & szItem2
        hNode = GetNodeByPath(szItem1)
        TreeView_DeleteItem hTVD, hNode
        'item data is updated by TVN_DELETE notification so all children receive it too
             
    Case SHCNE_RENAMEITEM, SHCNE_RENAMEFOLDER
DebugAppend "HandleShellNotify::code=" & dbg_LookUpSHCNE(lEvent) & ",itm1=" & szItem1 & ",itm2=" & szItem2
        If bRNf Then Exit Sub
        hNode = GetNodeByPath(szItem1)
        If hNode > 0& Then
            Dim lpFull As LongPtr, lpNameFull As LongPtr
            Dim sName As String, sFull As String, sNameFull As String
            Dim nIcon As Long
            Dim lAtr As SFGAOF
            siItem2.GetAttributes SFGAO_FOLDER, lAtr
            siItem2.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpFull
            sFull = LPWSTRtoStr(lpFull)
            siItem2.GetDisplayName SIGDN_NORMALDISPLAY, lpName
            sName = LPWSTRtoStr(lpName)
            If m_ForceExt = STEP_AlwaysShow Then
                siItem2.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpNameFull
                sNameFull = LPWSTRtoStr(lpNameFull)
                If (Left$(sNameFull, 3) <> "::{") And (Left$(sNameFull, 5) <> "uuid:") And ((InStr(sNameFull, "\?\usb#")) = 0) And (Left$(sNameFull, 7) <> "usb#vid") Then
                    sName = sNameFull
                End If
            End If
            nIcon = GetFileIconIndexPIDL(pidl2, SHGFI_SMALLICON)
            
            lIdx = GetIndexFromNode(hNode)
            
            With TVEntries(lIdx)
                .sName = sName
                .sNameFull = sNameFull
                .sFullPath = sFull
                If .nIcon <> nIcon Then
                    .nIcon = TranslateIcon(nIcon, siItem2, lAtr, TVEntries(nCur).pidlFQPar, TVEntries(nCur).pidlFQ, mIconSize * m_ScaleX, mIconSize * m_ScaleY, ILFindLastID(TVEntries(nCur).pidlFQ))
                    tVI.Mask = TVIF_IMAGE
                    tVI.iImage = nIcon
                    tVI.iSelectedImage = nIcon
                End If
            End With
            
            tVI.Mask = tVI.Mask Or TVIF_TEXT Or TVIF_HANDLE
            tVI.hItem = hNode
            tVI.cchTextMax = Len(TVEntries(lIdx).sName)
            tVI.pszText = StrPtr(TVEntries(lIdx).sName)
            
            SendMessage hTVD, TVM_SETITEMW, 0&, tVI
        End If
    Case SHCNE_MEDIAINSERTED
DebugAppend "HandleShellNotify::code=" & dbg_LookUpSHCNE(lEvent) & ",itm1=" & szItem1 & ",itm2=" & szItem2
        lIdx = GetIndexFromPath(szItem1)
        If lIdx >= 0 Then
            If TVEntries(lIdx).bDisabled = True Then
                TreeView_SetItemStateEx hTVD, TVEntries(lIdx).hNode, 0&
                TVEntries(lIdx).bDisabled = False
            End If
        End If
    Case SHCNE_MEDIAREMOVED
DebugAppend "HandleShellNotify::code=" & dbg_LookUpSHCNE(lEvent) & ",itm1=" & szItem1 & ",itm2=" & szItem2
        lIdx = GetIndexFromPath(szItem1)
        If lIdx >= 0 Then
            TreeView_SetItemStateEx hTVD, TVEntries(lIdx).hNode, TVIS_EX_DISABLED
            TVEntries(lIdx).bDisabled = True
        End If
Case SHCNE_UPDATEDIR
    'This shouldn't be raised besides add/remove device
    'Normal drives will get added via SHCNE_DRIVEADD
    'UPDATEDIR seems to be the only message we get if phone/camera type devices are
    'connected. So all we should need to do is scan specifically for those with the
    'Portable Device Manager... (Note: They do get SHCNE_DRIVEREMOVE, so we need only
    'worry about adding new ones with this update message).
    Dim tcc As Long, cdif As Long
    tcc = GetTickCount()
    If lUDTC <> 0 Then
        cdif = tcc - lUDTC
    Else
        cdif = 1001
    End If
    DebugAppend "UD Last=" & lUDTC & ",now=" & tcc & ",dif=" & CStr(cdif)
    lUDTC = tcc
    If cdif > 1000 Then
        ScanDevices
    End If
    
End Select
'<EhFooter>
Exit Sub

e0:
    DebugAppend "ucShellBrowse.HandleShellNotify->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Sub

Private Function ScanDevices() As Long
'Drives are detected via their own message that doesn't apply to devices
'All devices get are a SHCNE_UPDATEDIR message in Computer/This PC
'But we don't want to rescan and potentially spin up normal drives, so
'we'll just scan for portable devices like phones and cameras, because
'that's what we're really looking for.
Dim pMgr As IPortableDeviceManager
Set pMgr = New PortableDeviceManager
Dim nDev As Long, nDevAdded As Long
Dim lDev() As LongPtr
Dim sID() As String
Dim sFN As String
Dim wch() As Integer
Dim cchFN As Long
Dim sParse As String
Dim psi As IShellItem
Dim li As Long
Dim kCt As Long

pMgr.GetDevices 0&, nDev
DebugAppend "nDev=" & nDev
If nDev > 0 Then
    ReDim lDev(nDev - 1)
    pMgr.GetDevices VarPtr(lDev(0)), nDev
    ReDim sID(nDev - 1)
    Dim i As Long, j As Long
    For i = 0 To UBound(lDev)
        sID(i) = LPWSTRtoStr(lDev(i))
        DebugAppend "Got PortableDevice(" & i & ")=" & sID(i)
'        pMgr.GetDeviceFriendlyName sID(i), 0&, cchFN
'        ReDim wch(cchFN)
'        pMgr.GetDeviceFriendlyName sID(i), VarPtr(wch(0)), cchFN
'        sFN = WCHARtoSTR(wch)
'        DebugAppend "devid(" & i & ") Name=" & sFN
        sParse = AddBackslash(sComp) & sID(i)
        SHCreateItemFromParsingName StrPtr(sParse), Nothing, IID_IShellItem, psi
        If (psi Is Nothing) = False Then
            Dim hItemComp As LongPtr
            If mComputerAsRoot Then
                hItemComp = TreeView_GetRoot(hTVD)
            Else
                hItemComp = GetNodeByPath(sComp)
                
            End If
            If hItemComp Then
                Dim dwSt As ucst_TVITEM_State
                dwSt = TreeView_GetItemState(hTVD, hItemComp, TVIS_EXPANDED Or TVIS_EXPANDEDONCE)
                If dwSt Then
                    
                    Dim lIdxDV As Long
                    lIdxDV = GetIndexFromPath(sParse)
                    If (lIdxDV = -1&) Then
                        TVAddItem psi, hItemComp
                        nDevAdded = nDevAdded + 1
                    Else
                        If TVEntries(lIdxDV).bDeleted Then
                            TVAddItem psi, hItemComp
                            nDevAdded = nDevAdded + 1
                        End If
                    End If
                End If
            End If
        End If
nxt:
    Next i
    ScanDevices = nDevAdded
End If
End Function

Public Sub SetFocusOnTree()
' idTmr = SetTimer(0, WM_USER + 99, 10, 0&)
If mTmrProc = 0& Then mTmrProc = AddressOf FocusTimerProc
SetTimer hTVD, WM_USER + 99, 10, mTmrProc
End Sub

Private Sub DoSetFocus()
FastDoEvents 'DoEvents
SetFocusAPI hTVD
End Sub

Private Function pvShiftState() As Integer
  Dim lS As Integer
    If (GetAsyncKeyState(vbKeyShift) < 0) Then lS = lS Or vbShiftMask
    If (GetAsyncKeyState(vbKeyMenu) < 0) Then lS = lS Or vbAltMask
    If (GetAsyncKeyState(vbKeyControl) < 0) Then lS = lS Or vbCtrlMask
    pvShiftState = lS
End Function



Private Sub pvSetIPAO()
ActivateIPAO Me
End Sub

Private Sub IOleInPlaceActiveObjectVB_TranslateAccelerator(ByRef Handled As Boolean, ByRef RetVal As Long, ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal Shift As Long) Implements IOleInPlaceActiveObjectVB.TranslateAccelerator

Dim pMsg As MSG
pMsg.hWnd = hwnd
pMsg.wParam = wParam
pMsg.lParam = lParam
pMsg.message = wMsg
Handled = pvTranslateAccel(pMsg)

End Sub

Private Function pvTranslateAccel(pMsg As MSG) As Boolean
    
    Const IOleObject_GetClientSite As Long = 4 ' 2 From IUnknown + 2º Ordinal
    Dim pOleObject      As Long 'IOleObject
    Dim pOleControlSite As Long 'IOleControlSite
    Dim uiid As UUID, hEdit As Long
    
    On Error Resume Next
    Select Case pMsg.message
        Case WM_KEYDOWN, WM_KEYUP
            Select Case pMsg.wParam
'                Case vbKeyTab
'                    DebugAppend "vbKeyTab"
'                    If (pvShiftState() And vbCtrlMask) Then
'                        Call IIDFromString(StrPtr(szIID_IOleObject), uiid)
'                        Call CallInterface(ptrMe, ucst_IUnknown_Exports.QueryInterface, 2, VarPtr(uiid), VarPtr(pOleObject))
'                        Call CallInterface(pOleObject, IOleObject_GetClientSite, 1, VarPtr(pOleControlSite))
'                        If pOleControlSite Then
'                            Call IIDFromString(StrPtr(szIID_IOleControlSite), uiid)
'                            Call CallInterface(pOleControlSite, ucst_IUnknown_Exports.QueryInterface, 2, VarPtr(uiid), VarPtr(pOleControlSite))
'                            Call CallInterface(pOleControlSite, 7, 2, VarPtr(pMsg), pvShiftState() And vbShiftMask)
'                        End If
'                    End If
'                    pvTranslateAccel = False
                Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyHome, vbKeyEnd, vbKeyPageDown, vbKeyPageUp
                    DebugAppend "vbArrowKey"
'                    hEdit = pvEdithWnd()
                    If hLEEdit Then
                        Call SendMessage(hLEEdit, pMsg.message, pMsg.wParam, ByVal pMsg.lParam)
                    Else
                        Call SendMessage(hTVD, pMsg.message, pMsg.wParam, ByVal pMsg.lParam)
                    End If
                    pvTranslateAccel = True
            End Select
    End Select
    On Error GoTo 0
End Function

Private Sub FocusTimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal TimerID As LongPtr, ByVal Tick As Long)
    KillTimer hWnd, TimerID
    If hWnd = hTVD Then DoSetFocus
End Sub

'@3 - This procedure must be third to last in this module
Public Function ShellTreeLabelEditWndProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr
'Label Edit handler
'Label edits are used to rename files, so the in-place edit control is subclassed here
'to check whether an invalid character has been entered, and if so block it

Dim iCheck As Integer
Select Case uMsg
   Case WM_NOTIFYFORMAT
       ShellTreeLabelEditWndProc = NFR_UNICODE
       DebugAppend "NFR on LEWndProc"
       Exit Function
   Case WM_CHAR
      Select Case wParam
         Case VK_LEFT
             DebugAppend "LeftArrow"
         Case 47, 92, 60, 62, 58, 42, 124, 63, 34 'Illegal chars /\<>:*|?"
             Call ShowBalloonTipEx(hwnd, "", "File names may not contain any of the following characters:" & vbCrLf & " / \ < > : ? * | " & Chr$(34), TTI_NONE) ' TTI_ERROR)
             wParam = 0
             Exit Function
      End Select
     Case WM_UNICHAR
        If wParam = UNICODE_NOCHAR Then
            ShellTreeLabelEditWndProc = 1
            Exit Function
        Else
            SendMessage hwnd, WM_CHAR, wParam, ByVal lParam
            ShellTreeLabelEditWndProc = 1
            Exit Function
        End If
    Case WM_IME_CHAR
        SendMessage hwnd, WM_CHAR, wParam, ByVal lParam
        ShellTreeLabelEditWndProc = 1
        Exit Function
     
     Case WM_PASTE
         iCheck = IsClipboardValidFileName()
         If iCheck = -1 Then
             Beep
             Call ShowBalloonTipEx(hwnd, "", "File names may not contain any of the following characters:" & vbCrLf & " / \ < > : ? * | " & Chr$(34), TTI_NONE) ' TTI_ERROR)
             Exit Function
         ElseIf iCheck = -2 Then
             Beep
             Call ShowBalloonTipEx(hwnd, "", "The file name you have entered is too long. The total length of the path and file name cannot exceed " & CStr(MAX_PATH) & " characters.", TTI_NONE) ' TTI_ERROR)
             Exit Function

         End If
     Case WM_NOTIFY
         Dim NM As NMHDR
         CopyMemory NM, ByVal lParam, LenB(NM)
         Select Case NM.Code
             Case WM_NOTIFYFORMAT
                ShellTreeLabelEditWndProc = NFR_UNICODE
                Exit Function
                DebugAppend "NFR on LEWndProc@WM_NOTIFY"
         End Select
         
    Case WM_DESTROY
      Call UnSubclass(hwnd, PtrSTLEWndProc, uIdSubclass)
End Select
ShellTreeLabelEditWndProc = DefSubclassProc(hwnd, uMsg, wParam, lParam)
End Function
Private Function PtrSTLEWndProc() As LongPtr
    PtrSTLEWndProc = FARPROC(AddressOf ShellTreeLabelEditWndProc)
End Function
'@2 - This procedure must be second to last in this module
Public Function TVSortProc(ByVal lParam1 As LongPtr, ByVal lParam2 As LongPtr, ByVal lParamSort As LongPtr) As Long
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim hr As Long
Dim pidlRel1 As LongPtr, pidlRel2 As LongPtr

pidlRel1 = TVEntries(lParam1).pidlRel
pidlRel2 = TVEntries(lParam2).pidlRel

hr = psfCur.CompareIDs(0&, pidlRel1, pidlRel2)

If (hr >= NOERROR) Then
  If (lParamSort And SORT_ASCENDING) = 0 Then
    TVSortProc = LoWord(hr)
  Else
    TVSortProc = LoWord(hr) * -1
  End If
End If
 
'<EhFooter>
Exit Function

e0:
    DebugAppend "ucShellTree.TVSortProc->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
'</EhFooter>
End Function

'*3
'@1 - This procedure must be the last in this module
Public Function ShellTreeSubclassProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr
    '<EhHeader>
    On Error GoTo e0
    '</EhHeader>
Dim PT As POINT
Dim tvhti As TVHITTESTINFO
Dim tVI As TVITEM
Dim tvix As TVITEMEX
Dim i As Long
Dim ulAtrrs As Long
Dim lLen As Long, lSel As Long
Dim sText As String
Dim lp As LongPtr

Select Case uMsg
    Case WM_DESTROY
      Call UnSubclass(hwnd, AddressOf ShellTreeSubclassProc, uIdSubclass)
      
    Case WM_NOTIFYFORMAT
        DebugAppend "Got NFMT on ftv main"
        ShellTreeSubclassProc = NFR_UNICODE
        Exit Function
    
    ' Case WM_TIMER
    '     DebugAppend "Got WM_TIMER, wParam=" & wParam & ",id=" & idTmr
    '     If wParam = idTmr Then
    '         KillTimer 0, WM_USER + 99
    '         DoSetFocus
    '     End If
'  Case WM_PAINT
'     If lng_hWnd = hTVD Then
'        Dim hdcInst As Long, hdcBitmap As Long
'        Dim ps As PAINTSTRUCT
'        Dim bp As BITMAP
'        Call GetObject(hBmpBack, LenB(bp), bp)
'        hdcInst = BeginPaint(lng_hWnd, ps)
''        hdcInst = GetDC(lng_hWnd)
'        SetBkMode hdcInst, TRANSPARENT
'
'        '// Create a memory device compatible with the above DC variable
'
'        hdcBitmap = CreateCompatibleDC(hdcInst) '
'
'        '// Select the new bitmap
'        SetBkMode hdcBitmap, TRANSPARENT
'
'        Call SelectObject(hdcBitmap, hBmpBack) '
'
'        '// Get client coordinates for the StretchBlt() function
'
'        Dim R As RECT 'r;
'        GetClientRect lng_hWnd, R
'
'        '// troublesome part, in my oppinion
''        StretchBlt hdcInst, 0, 0, r.Right - r.Left, r.Bottom - r.Top, hdcBitmap, 0, 0, bp.BMWidth, bp.BMHeight, MERGECOPY
'        TransparentBlt hdcInst, 0, 0, R.Right - R.Left, R.Bottom - R.Top, hdcBitmap, 0, 0, bp.BMWidth, bp.BMHeight, MERGECOPY
'
'        '// Cleanup
'
'        DeleteDC hdcBitmap
'        EndPaint lng_hWnd, ps
'   End If
'
'    Case WM_ERASEBKGND
'        lReturn = 1
'        bHandled = True
        
    Case WM_SHOWWINDOW
        If Ambient.UserMode Then
            If wParam = 1 Then
                If hTVD Then Attach hTVD
            Else
                Detach
            End If
        End If
    
    Case WM_UNICHAR
        If wParam = UNICODE_NOCHAR Then
            ShellTreeSubclassProc = 1
            Exit Function
        Else
            SendMessage hwnd, WM_CHAR, wParam, ByVal lParam
            Exit Function
        End If
        
    Case WM_IME_CHAR
        SendMessage hwnd, WM_CHAR, wParam, ByVal lParam
        Exit Function
        
    Case WM_MOUSEACTIVATE
        If hwnd = UserControl.hWnd Then
            'DebugAppend "WM_MA UC.hWnd", 2
            Call pvSetIPAO
            DebugAppend "WM_MOUSEACTIVATE pvSetIPAO Return"
'            bFirstIPAOEvt = True
        End If
        
    Case WM_SETFOCUS '        If lng_hWnd = hTVD Then
'            If bTopLostFocus Then
'            SetFocus hTVD
'            pvSetIPAO
'            bTopLostFocus = False
'        End If
''            Call pvSetIPAO
'        End If
        If hwnd = hTVD Then
          If bHasFocus = False Then
'            pvSetIPAO
            bHasFocus = True
            'DebugAppend "WM_SETFOCUS pvSetIPAO Return"
          End If
        End If
        
    Case WM_KILLFOCUS
        bTopLostFocus = True
        If hwnd = hTVD Then
            bHasFocus = False
        End If
        'DebugAppend "WM_KILLFOCUS"
        
    Case WM_SHNOTIFY
        Dim lEvent As Long
        Dim pInfo As LongPtr
        Dim tInfo As SHNOTIFYSTRUCT
        Dim hNotifyLock As LongPtr
        hNotifyLock = SHChangeNotification_Lock(wParam, CLng(lParam), pInfo, lEvent)
        If hNotifyLock Then
            CopyMemory tInfo, ByVal pInfo, LenB(tInfo)
            HandleShellNotify tInfo.dwItem1, tInfo.dwItem2, lEvent
            Call SHChangeNotification_Unlock(hNotifyLock)
        End If
        
    Case WM_MENUSELECT
            Dim szt As String
            Dim lw As Long
            On Error Resume Next
            lw = LoWord(CLng(wParam))
            If lw = 0 Then
                UpdateStatus ""
            ElseIf lw > 0 Then
                szt = String$(MAX_PATH, 0&)
                If (ICtxMenu2 Is Nothing) = False Then
                    If lw = wIDSel Then
                        szt = "Selects the current file."
                    Else
                        Call ICtxMenu2.GetCommandString(lw - 1, GCS_HELPTEXTW, 0&, StrPtr(szt), Len(szt))
                        szt = TrimNullW(szt)
                    End If
                End If
                UpdateStatus szt
            End If

    Case WM_NOTIFY
        Dim nmtv As NMTREEVIEW
        Dim hTVDW As LongPtr
        Dim nmtvic As NMTVITEMCHANGE
        Dim hItemChild As LongPtr
        Dim hItemPar As LongPtr
        Dim hItemRoot As LongPtr
      
        CopyMemory nmtv, ByVal lParam, LenB(nmtv)
        hTVDW = nmtv.hdr.hWndFrom
        
        Select Case nmtv.hdr.Code
            Case TVN_KEYDOWN
                Dim nmkd As NMTVKEYDOWN
                Dim pCTM As IContextMenu
                Dim iSel As LongPtr
                CopyMemory nmkd, ByVal lParam, LenB(nmkd)
'                DebugAppend "KeyDown 0x" & Hex$(nmkd.wVKey)
                RaiseEvent TreeKeyDown(nmkd.wVKey)
                iSel = TreeView_GetSelection(hTVD)
                Select Case nmkd.wVKey
                
                    Case vbKeyF2
                        If i Then
                            SendMessage hTVD, TVM_EDITLABELW, 0&, ByVal iSel
                        End If
                    Case vbKeyDelete
                        DebugAppend "DelPress i=" & i
                        If i Then
                            lp = GetTVItemlParam(hTVD, iSel)
                            If (TVEntries(lp).dwAttrib And SFGAO_CANDELETE) = SFGAO_CANDELETE Then
                               If GetAsyncKeyState(vbKeyShift) Then
                                   Dim sL() As String
                                   ReDim sL(0)
                                   sL(0) = TVEntries(lp).sFullPath
                                   Call DeleteFile(sL)
    
                               Else
                                   SetSelection lp, iSel
                                   siSelected.BindToHandler 0&, BHID_SFUIObject, IID_IContextMenu, pCTM
                                   If (pCTM Is Nothing) = False Then
                                       InvokeVerb pCTM, "delete"
                                       ShellTreeSubclassProc = 1
                                       Exit Function
                                   End If
                               End If
                            End If
                        End If
                    Case vbKeyC
                        If GetAsyncKeyState(VK_CONTROL) Then
                            SetSelection lp, iSel
                            siSelected.BindToHandler 0&, BHID_SFUIObject, IID_IContextMenu, pCTM
                            If (pCTM Is Nothing) = False Then
                                InvokeVerb pCTM, "copy"
                                ShellTreeSubclassProc = 1
                                Exit Function
                            End If
                        End If
                    Case vbKeyX
                        If GetAsyncKeyState(VK_CONTROL) Then
                            lp = GetTVItemlParam(hTVD, iSel)
                            DebugAppend "Cut " & TVEntries(lp).sName
                            SetSelection lp, iSel
                            siSelected.BindToHandler 0&, BHID_SFUIObject, IID_IContextMenu, pCTM
                            If (pCTM Is Nothing) = False Then
                                InvokeVerb pCTM, "cut"
                                TVCutSelected
                                ShellTreeSubclassProc = 1
                                Exit Function
                            End If
                        End If
                    Case vbKeyV
                        If GetAsyncKeyState(VK_CONTROL) Then
                            lp = GetTVItemlParam(hTVD, iSel)
                            DebugAppend "Paste to " & TVEntries(lp).sName
                            SetSelection lp, iSel
                            TVDoPaste
                            ShellTreeSubclassProc = 1
                            Exit Function
                        End If
                            
                End Select
        
            Case TVN_DELETEITEMW
                If g_fDeleting = False Then
                    Dim hItemDel As LongPtr, hSibDel As LongPtr
                    TVEntries(nmtv.itemOld.lParam).bDeleted = True
                    hItemPar = TreeView_GetParent(hTVD, nmtv.itemOld.hItem)
                    hItemDel = TreeView_GetChild(hTVD, hItemPar)
                    hSibDel = TreeView_GetNextSibling(hTVD, hItemDel)
                    'If the last child has been deleted, clear the expando button
                    If (hItemDel = 0) Or ((hItemDel = nmtv.itemOld.hItem) And (hSibDel = 0)) Then
                        tVI.Mask = TVIF_CHILDREN Or TVIF_HANDLE
                        tVI.hItem = hItemPar
                        tVI.cChildren = 0
                        TreeView_SetItem hTVD, tVI
                    End If
                End If
            Case TVN_BEGINLABELEDITW
                DebugAppend "ucWndProc@BgLabelEditW"
                Dim iSel2 As LongPtr
                iSel2 = TreeView_GetSelection(hTVD)
                SetFocusAPI UserControl.ContainerHwnd
                SetFocusAPI hTVD
                Dim ni5 As LongPtr
                ni5 = GetTVItemlParam(hTVD, iSel2)
                ulAtrrs = TVEntries(ni5).dwAttrib
                If (ulAtrrs And SFGAO_CANRENAME) = SFGAO_CANRENAME Then
    
                'deselect the file name extension by default when renaming by label edit, like in explorer.
    
                    hLEEdit = SendMessage(hTVD, TVM_GETEDITCONTROL, 0, ByVal 0&)
                    If hLEEdit Then
                        lLen = CLng(SendMessageW(hLEEdit, WM_GETTEXTLENGTH, 0, ByVal 0&))
                        sText = String$(lLen, 0)
                        Call SendMessageW(hLEEdit, WM_GETTEXT, lLen, ByVal StrPtr(sText))
                        dbg_stringbytes sText
                        dbg_stringbytes TVEntries(ni5).sName
                        DebugAppend "LabelEdit:Orig text=" & sText & ",len=" & lLen
                        sOldLEText = sText
                        If (TVEntries(ni5).bFolder = False) Or (TVEntries(ni5).bZip = True) Then
                            'for files (and zip files), deselect the extension by default
                            If InStr(sText, ".") Then
                                lSel = InStrRev(sText, ".") - 1
                                If lSel > 0 Then
                                    DebugAppend "LabelEdit:EM_SETSEL=" & lSel
                                    Call SendMessage(hLEEdit, EM_SETSEL, 0, ByVal lSel)
                                End If
                            End If
                        End If
                        'We also want to detect invalid characters, to do it properly we need to
                        'subclass the edit control- where the WM_CHAR message is sent
                        Subclass hLEEdit, AddressOf ShellTreeLabelEditWndProc, hLEEdit, ObjPtr(Me)
         
                        Exit Function
                    End If
    
                Else 'cannot rename
        
                    DebugAppend "TVN_BEGINLABELEDIT: Cancelling, SFGAO_CANRENAME=False"
                    Beep
                    ShellTreeSubclassProc = 1
                    Exit Function
        
                End If
            Case TVN_ENDLABELEDITW
                DebugAppend "ucWndProc@EndLabelEditW"
                hLEEdit = 0&
                Dim NMTVDI As NMTVDISPINFO
                CopyMemory NMTVDI, ByVal lParam, LenB(NMTVDI)
                Dim lSL As Long
                Dim sBuf As String
                Dim sNewText As String
                Dim iSel3 As LongPtr
                lLen = 0&
                iSel3 = NMTVDI.Item.hItem
                hLEEdit = SendMessage(hTVD, TVM_GETEDITCONTROL, 0, ByVal 0&)
                If hLEEdit Then
                    lLen = CLng(SendMessageW(hLEEdit, WM_GETTEXTLENGTH, 0, ByVal 0&))
                    sBuf = String$(lLen, 20)
                    Call SendMessageW(hLEEdit, WM_GETTEXT, lLen + 1, ByVal StrPtr(sBuf))
                    lSL = lstrlenW(ByVal StrPtr(sBuf))
                    DebugAppend "buflen=" & lSL & ",len=" & lLen
                    sBuf = Left$(sBuf, lSL)
                    dbg_stringbytes sBuf
                Else
                    DebugAppend "No edit control @EndLabelEdit"
                End If
                Dim sBuf2 As String

                sBuf2 = LPWSTRtoStr(NMTVDI.Item.pszText, False)
                If (sBuf2 <> "") And (sBuf2 <> CStr(vbNullChar)) And (sBuf <> sOldLEText) Then
                    Dim tOld As TVEntry, tNew As TVEntry
                    Dim idx As LongPtr
                    Dim sOld As String, sNew As String
                    idx = GetTVItemlParam(hTVD, iSel3)
                    tOld = TVEntries(idx)
                    If tOld.sName <> sBuf Then
                        tNew = tOld
                        tNew.sName = sBuf
                        If tOld.sName <> tOld.sNameFull Then 'hidden extension
                            sOld = AddBackslash(tOld.sParentFull) & tOld.sNameFull
                            sNew = tNew.sName
                            tNew.sNameFull = sNew
                            tNew.sFullPath = AddBackslash(tNew.sParentFull) & tNew.sNameFull
                        Else
                            sOld = tOld.sFullPath
                            sNew = tNew.sName
                            tNew.sNameFull = tNew.sName
                            tNew.sFullPath = AddBackslash(tNew.sParentFull) & tNew.sNameFull
                        End If
                        DebugAppend "Name " & sOld & " As " & tNew.sFullPath
                        Dim hrrf As Long
                        bRNf = True
                        hrrf = RenameFile(sOld, sNew)
                        If PathFileExistsW(StrPtr(tNew.sFullPath)) Then
                            DebugAppend "Rename::Notify"
                            'notify the shell that we have renamed the item
    '                            Call SHChangeNotify(SHCNE_RENAMEITEM, SHCNF_PATHW, StrPtr(tOld.sFullPath), StrPtr(tNew.sFullPath))
    '                            bRNf = False
                            TVEntries(idx) = tNew
                            Dim tvi2 As TVITEM
                            tvi2.Mask = TVIF_TEXT
                            tvi2.hItem = TVEntries(idx).hNode
                            tvi2.cchTextMax = Len(tNew.sName)
                            tvi2.pszText = StrPtr(tNew.sName)
                            SendMessageW hTVD, TVM_SETITEMW, 0&, tvi2
    
                            DebugAppend "Rename::Out"
                            dbg_stringbytes sNew
                            RaiseEvent ItemRename(tOld.sName, tNew.sName, tOld.sFullPath, tNew.sFullPath, tOld.bFolder, NMTVDI.Item.hItem)
'                            lReturn = 1
'    '                            bHandled = True
                        Else
                            Beep
                            DebugAppend "Rename::Fail, 0x" & Hex$(hrrf)
                            UpdateStatus "Could not rename file."
                        End If
                        bRNf = False
                    End If
                End If

        'Handle check/uncheck logic that should be built in........
            Case TVN_ITEMCHANGINGW
                If (bFilling = False) And (g_fDeleting = False) And (mAutocheck = True) Then
                    Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
                    tvix.Mask = TVIF_STATEEX
                    tvix.hItem = nmtvic.hItem
                    Call SendMessage(hTVDW, TVM_GETITEM, 0, tvix)
                    If (tvix.uStateEx And TVIS_EX_DISABLED) = TVIS_EX_DISABLED Then 'for some reason disabled items can still be checked...
                        DebugAppend "ChangeBlock: Disabled"
                        ShellTreeSubclassProc = 1
                        Exit Function
                    End If
                    If (nmtvic.hItem = m_hRoot) And (mRootHasCheckbox = False) Then
                        If (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) <> 0& Then
                            DebugAppend "ChangeBlock: Root check disabled"
                            ShellTreeSubclassProc = 1
                            Exit Function
                        End If
                    End If
                ElseIf (bFilling = False) And (g_fDeleting = False) Then
                      'MITH
                     Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
                     tvix.Mask = TVIF_STATEEX
                     tvix.hItem = nmtvic.hItem
                     If (tvix.uStateEx And TVIS_EX_DISABLED) = TVIS_EX_DISABLED Then 'for some reason disabled items can still be checked...
                         DebugAppend "ChangeBlockB: Disabled"
                         ShellTreeSubclassProc = 1
                         Exit Function
                     End If
                     Call SendMessage(hTVDW, TVM_GETITEM, 0, tvix)
                     If (nmtvic.hItem = m_hRoot) And (mRootHasCheckbox = False) Then
                        ShellTreeSubclassProc = 1
                        Exit Function
                     End If
                     idx = GetTVItemlParam(hTVD, nmtvic.hItem)
                     tNew = TVEntries(idx)
                     If (tNew.bFolder = True And mShowOnlyFileCheckbox = True And mShowFiles = True) Then
                        ShellTreeSubclassProc = 1
                        Exit Function
                     End If
                End If
                
            Case TVN_ITEMCHANGEDW
                 Dim bNeedCopy As Boolean
                 If mMultiSel Then
                    Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
                    If (nmtvic.uStateNew And TVIS_SELECTED) = TVIS_SELECTED Then
                        SetSelection nmtvic.lParam, nmtvic.hItem
                    End If
                 End If
                 If (bFilling = False) And (g_fDeleting = False) Then
                    Call CopyMemory(nmtvic, ByVal lParam, LenB(nmtvic))
                    If (mAutocheck = True) Then
                        If (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = (nmtvic.uStateOld And TVIS_STATEIMAGEMASK) Then Exit Function
                        DebugAppend "itemchanging, mask=" & Hex$((nmtvic.uStateNew And TVIS_STATEIMAGEMASK)) & ",item=" & GetTVItemText(hTVD, nmtvic.hItem)
                        
                        If (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H2000 Then 'item has been checked
                            Dim sPath As String
                            'RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, 1&, nmtvic.hItem)
                            If bSetParents = False Then
                                'set child states
                                If (nmtvic.uStateNew And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE Then
                                    hItemChild = TreeView_GetChild(hTVDW, nmtvic.hItem)
                                    If hItemChild Then
                                        bSetParents = True
                                        TVCheckChildren hItemChild
                                        bSetParents = False
                                    End If
                                End If
                                'set parent states
                                bSetParents = True
                                hItemPar = TreeView_GetParent(hTVD, nmtvic.hItem)
                                If (hItemPar <> m_hRoot) And (hItemPar <> m_hFav) Then
                                    TVSetParentAfterCheck hItemPar
                                End If
                                bSetParents = False
                            End If
                        ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H4000 Then
                            If bSetParents = False Then
                                If (nmtvic.uStateNew And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE Then
                                    hItemChild = TreeView_GetChild(hTVDW, nmtvic.hItem)
                                    If hItemChild Then
                                        bSetParents = True
                                        TVExcludeChildren hItemChild
                                        bSetParents = False
                                    End If
                                End If
                           End If
                        ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H1000 Then
                            DebugAppend "UncheckEntry " & GetTVItemText(hTVD, nmtvic.hItem)
                            ' RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, 0&, nmtvic.hItem)
                            If bSetParents = False Then
                                Dim bSib As Boolean
                                hItemRoot = TreeView_GetRoot(hTVD)
                                DebugAppend "got root"
                                If (nmtvic.uStateNew And TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE Then
                                    'uncheck all children
                                    bSetParents = True
                                    hItemChild = TreeView_GetChild(hTVD, nmtvic.hItem)
                                    TVUncheckAllChildren hTVD, hItemChild
                                    bSetParents = False
                                End If
                                bSetParents = True
                                hItemPar = TreeView_GetParent(hTVD, nmtvic.hItem)
                                If (hItemPar <> m_hRoot) And (hItemPar <> m_hFav) Then
                                    TVSetParentAfterUncheck hItemPar
                                End If
                                bSetParents = False
        
                            End If
                        ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H3000 Then
                            If bSetParents = False Then
                                'Roll over to excluded or empty; don't want partial user-set
                                If mExCheckboxes Then
                                    SetTVItemStateImage nmtvic.hItem, tvcsExclude
                                Else
                                    SetTVItemStateImage nmtvic.hItem, tvcsEmpty
                                End If
                            End If
                        End If
                    End If
                End If
                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, 0&, nmtvic.hItem)
                ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H2000 Then
                    DebugAppend "ItemCheck"
                    TVEntries(nmtvic.lParam).Checked = True
                    TVEntries(nmtvic.lParam).Excluded = False
                    RaiseEvent ItemCheck(TVEntries(nmtvic.lParam).sName, TVEntries(nmtvic.lParam).sFullPath, TVEntries(nmtvic.lParam).bFolder, 1&, nmtvic.hItem)
                ElseIf ((nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H3000) And (mAutocheck = True) Then
                    TVEntries(nmtvic.lParam).Checked = False
                    If mExCheckboxes Then
                        TVEntries(nmtvic.lParam).Excluded = True
                    End If
                ElseIf ((nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H3000) And (mAutocheck = False) Then
                    DebugAppend "ItemExclude"
                    If mExCheckboxes Then
                        TVEntries(nmtvic.lParam).Checked = False
                        TVEntries(nmtvic.lParam).Excluded = True
                    Else
                        SetTVItemStateImage nmtvic.hItem, tvcsEmpty
                    End If
                ElseIf (nmtvic.uStateNew And TVIS_STATEIMAGEMASK) = &H4000 Then
                    TVEntries(nmtvic.lParam).Checked = False
                    TVEntries(nmtvic.lParam).Excluded = True
                End If
                
            Case TVN_SELCHANGEDW
                tvix.Mask = TVIF_STATEEX
                tvix.hItem = nmtv.itemNew.hItem
                Call SendMessage(hTVDW, TVM_GETITEM, 0, tvix)
                If (tvix.uStateEx And TVIS_EX_DISABLED) = TVIS_EX_DISABLED Then 'for some reason disabled items can still be checked...
'                    lReturn = 1
'                    bHandled = True
                    Exit Function
                End If
                If fLoad = 0 Then PlayNavSound
                lp = nmtv.itemNew.lParam ' GetTVItemlParam(hTVD, nmtv.itemNew.)
                DebugAppend "SelectionChange " & TVEntries(lp).sName & ",Raise=" & fLoad & ",lp=" & lp & ",hItem=" & nmtv.itemNew.hItem

                gCurSelIdx = lp
                SetSelection lp, nmtv.itemNew.hItem
                If (mExpandOnLabelClick = False) And (bNavigating = False) And (fLoad = 0&) Then
                    bFlagBlockClkExp = True
                End If
                
            Case TVN_ITEMEXPANDINGW
                DebugAppend "TVN_ITEMEXPANDINGW"
                If (fNoExpand > 0) Or (bFlagBlockClkExp = True) Then
                    If fRefreshing = 0 Then
                    
                        DebugAppend "Blocked Expand " & fNoExpand & "," & bFlagBlockClkExp
                        ShellTreeSubclassProc = 1
                        
                        If bFlagBlockClkExp Then
                            bBlockExec = True
                            bFlagBlockClkExp = False
                        End If
                        Exit Function
                    End If
                End If
                If (nmtv.Action And TVE_EXPAND) Then
                    RaiseEvent ItemExpand(TVEntries(nmtv.itemNew.lParam).sName, TVEntries(nmtv.itemNew.lParam).sFullPath, nmtv.itemNew.hItem)
                ElseIf (nmtv.Action And TVE_COLLAPSE) Then
                    RaiseEvent ItemCollapse(TVEntries(nmtv.itemNew.lParam).sName, TVEntries(nmtv.itemNew.lParam).sFullPath, nmtv.itemNew.hItem)
                End If
                If (nmtv.itemNew.State And TVIS_EXPANDEDONCE) Then Exit Function
                DebugAppend "TVN_ITEMEXPANDINGW->" & TVEntries(nmtv.itemNew.lParam).sName & "|" & GetTVItemText(hTVD, nmtv.itemNew.hItem)
                Dim tvif As TVITEM
                tvif.Mask = TVIF_PARAM
                tvif.hItem = nmtv.itemNew.hItem
                TreeView_GetItem hTVD, tvif
                
                Call TVExpandFolder(tvif.lParam, nmtv.itemNew.hItem)
                DebugAppend "lParamOrig=" & nmtv.itemNew.lParam & ",resolve=" & tvif.lParam

                ' Setup the callback and sort the items
                Dim tvscb As TVSORTCB
                tvscb.hParent = nmtv.itemNew.hItem
                If m_cbSort = 0& Then m_cbSort = FARPROC(AddressOf TVSortProc)
                tvscb.lpfnCompare = m_cbSort
                tvscb.lParam = ObjPtr(Me)
                lParamSort = 0&
                Call TreeView_SortChildrenCB(hTVDW, tvscb, 0&)
            Case TVN_ITEMEXPANDEDW
                bBlockExec = False
                
                hItemBlocked = 0
            Case TVN_BEGINDRAGW, TVN_BEGINRDRAGW
                Dim sSel() As String, nSel As Long
                Dim apidl() As LongPtr, cpidl As Long
                Dim hItemSel As LongPtr
                Dim lpSel As LongPtr
                ReDim sSel(0): ReDim apidl(0)
                DebugAppend "TVN_BEGINDRAG"
                Do
                    hItemSel = TreeView_GetNextSelected(hTVD, hItemSel)
                    If hItemSel Then
                        lpSel = GetTVItemlParam(hTVD, hItemSel)
                        ReDim Preserve sSel(nSel)
                        sSel(nSel) = TVEntries(lpSel).sFullPath
                        DebugAppend "Drag " & sSel(nSel)
                        nSel = nSel + 1
                        ReDim Preserve apidl(cpidl)
                        apidl(cpidl) = ILCombine(TVEntries(lpSel).pidlFQPar, TVEntries(lpSel).pidlRel)
                        cpidl = cpidl + 1
                    End If
                Loop While hItemSel
                If nSel > 0& Then
                    Dim psia As IShellItemArray
                    Dim iData As IDataObject
                    DebugAppend "Dragging " & nSel & " items"
                    SHCreateShellItemArrayFromIDLists cpidl, VarPtr(apidl(0)), psia
                    If (psia Is Nothing) = False Then
                        psia.BindToHandler 0&, BHID_DataObject, IID_IDataObject, iData
                        If (iData Is Nothing) = False Then
                            RaiseEvent DragStart(sSel, psia, iData)
                            Dim hr0 As Long, lRetDD As Long
                            hr0 = SHDoDragDrop(0&, ObjPtr(iData), 0&, DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK, lRetDD)
                            DebugAppend "Executed drag " & Join(sSel, "|")
                        Else
                            DebugAppend "Drag::Failed to create iData"
                        End If
                    Else
                        DebugAppend "Drag::Failed to create array"
                    End If
                    For i = 0 To UBound(apidl)
                        CoTaskMemFree apidl(i)
                    Next i
                End If
            
''''                    DebugAppend "TVN_BEGINDRAGW"
''''             ' Get the highlighted treeview item (instead of just TVHT_ONITEM)
''''                Call GetCursorPos(PT)
''''                Call ScreenToClient(hTVDW, PT)
''''                tvhti.PT = PT
''''                Call TreeView_HitTest(hTVDW, tvhti)
''''                If (tvhti.Flags And TVHT_ONITEMLINE) Then
''''
''''                    tVI.Mask = TVIF_PARAM
''''                    tVI.hItem = tvhti.hItem
''''                    If TreeView_GetItem(hTVDW, tVI) Then
''''                        Dim hr0 As Long
''''                        Dim iData As IDataObject
''''                        Dim apidl() As Long
''''                        Dim cpidl As Long
''''                        Dim pidlDesk As Long
''''                        Dim lRetDD As Long
''''                        Dim AllowedEffects As DROPEFFECTS
''''                        Dim psi As IShellItem
''''                        Dim ppidlp As Long
''''                        SHCreateItemFromParsingName StrPtr(TVEntries(tVI.lParam).sFullPath), Nothing, IID_IShellItem, psi
''''                        If (psi Is Nothing) Then
''''                            DebugAppend "ucWndProc::BeginDrag->ShellItem failed, trying to load from pidls...", 3
''''                            If (TVEntries(tVI.lParam).pidlFQPar <> 0&) And (TVEntries(tVI.lParam).pidlRel <> 0&) Then
''''                                ppidlp = ILCombine(TVEntries(tVI.lParam).pidlFQPar, TVEntries(tVI.lParam).pidlRel)
''''                                SHCreateItemFromIDList ppidlp, IID_IShellItem, psi
''''                                If (psi Is Nothing) = False Then
''''                                    DebugAppend "ucWndProc::LoadFromPidl->Success!", 3
''''                                Else
''''                                    DebugAppend "ucWndProc::LoadFromPidl->Failed.", 3
''''                                End If
''''                            Else
''''                                DebugAppend "ucWndProc::LoadFromPidl->Parent or child pidl not set.", 3
''''                            End If
''''                            If ppidlp Then CoTaskMemFree ppidlp
''''                        End If
''''
''''                        If (psi Is Nothing) = False Then
''''                            psi.BindToHandler 0&, BHID_DataObject, IID_IDataObject, iData
''''                            If (iData Is Nothing) = False Then
''''                                DebugAppend "tvdrag->valid ido"
'''''                                If DataObjSupportsFormat(iData, CF_PREFERREDDROPEFFECT) Then
''''
'''''                                    If GetPreferredEffect(iData) = DROPEFFECT_LINK Then
'''''                                        AllowedEffects = DROPEFFECT_LINK
'''''                                    Else
''''                                        AllowedEffects = DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK
'''''                                    End If
'''''                                End If
''''
''''                                hr0 = SHDoDragDrop(0&, ObjPtr(iData), 0&, AllowedEffects, lRetDD)
''''                                DebugAppend "tvdrag->hr=" & Hex$(hr0)
''''                            Else
''''                                DebugAppend "tvdrag->no ido"
''''                            End If
''''                        Else
''''                            DebugAppend "tvdrag->no psi"
''''                        End If
''''                    End If
''''                End If
            Case TVN_GETINFOTIPW
    '                DebugAppend "TVN_GETINFOTIPW"
                Dim nmtvgit As NMTVGETINFOTIP
                CopyMemory nmtvgit, ByVal lParam, LenB(nmtvgit)
                With nmtvgit
                If .hItem > 0 And .pszText <> 0 Then
                    Dim sInfoTip As String
                    Dim nTipItem As LongPtr
                    nTipItem = GetTVItemlParam(hTVD, .hItem)
'                        DebugAppend "QueryInfoTip " & TVEntries(nTipItem).sName & ",bFolder=" & TVEntries(nTipItem).bFolder
                    If (TVEntries(nTipItem).sInfoTip <> "") Then
                        sInfoTip = TVEntries(nTipItem).sInfoTip
                    Else
                        If (TVEntries(nTipItem).bFolder = True) And (mInfoTipOnFolders = True) Then
                            sInfoTip = GenerateInfoTip(nTipItem)
                            TVEntries(nTipItem).sInfoTip = sInfoTip
                        End If
                        If (TVEntries(nTipItem).bFolder = False) And (mInfoTipOnFiles = True) Then
                            sInfoTip = GenerateInfoTip(nTipItem)
                            TVEntries(nTipItem).sInfoTip = sInfoTip
                        End If
                    End If
                    If Not sInfoTip = vbNullString Then
                        sInfoTip = Left$(sInfoTip, .cchTextMax - 1) & vbNullChar
                        CopyMemory ByVal .pszText, ByVal StrPtr(sInfoTip), LenB(sInfoTip)
                    Else
                        CopyMemory ByVal .pszText, 0, LenB(.pszText)
                    End If

                End If
                End With
            Case NM_DBLCLK
                If nmtv.hdr.hWndFrom = hTVD Then
                    DebugAppend "DoubleClick"
                    If mExpandOnLabelClick = False Then
                        If bBlockExec Then
                            If hItemBlocked Then
                            bFlagBlockClkExp = False
                            TreeView_Expand hTVD, hItemBlocked, TVE_TOGGLE
                            bBlockExec = False
                            End If
                        End If
                    End If
                    
                End If
            Case NM_CLICK
                DebugAppend "NM_CLICK"
                If nmtv.hdr.hWndFrom = hTVD Then
                DebugAppend "NM_CLICK hTVD"
'                    SetFocus UserControl.ContainerHwnd
'                    SetFocus hTVD
                    Call GetCursorPos(PT)
                    Call ScreenToClient(hTVDW, PT)
                    tvhti.PT = PT
                    Call TreeView_HitTest(hTVDW, tvhti)
                    bFlagBlockClkExp = False
                    If (tvhti.Flags And TVHT_ONITEMLINE) Then
                        tVI.Mask = TVIF_PARAM Or TVIF_CHILDREN
                        tVI.hItem = tvhti.hItem
                        nItr = tvhti.hItem
                        If TreeView_GetItem(hTVDW, tVI) Then
                            DebugAppend "RaiseEvent(Click)->" & TVEntries(tVI.lParam).sFullPath
                            If mMultiSel Then
                                SetMultiSel
                            End If
                            RaiseEvent ItemClick(TVEntries(tVI.lParam).sName, TVEntries(tVI.lParam).sFullPath, TVEntries(tVI.lParam).bFolder, MK_LBUTTON, tvhti.hItem)
                            RaiseEvent ItemClickByShellItem(siSelected, TVEntries(tVI.lParam).sName, TVEntries(tVI.lParam).sFullPath, TVEntries(tVI.lParam).bFolder, MK_LBUTTON, tvhti.hItem)
                            If mExpandOnLabelClick = False Then
                                If ((tvhti.Flags And TVHT_ONITEMBUTTON) = 0&) And (tVI.cChildren > 0) Then
                                    If (bNavigating = False) Then
                                        bFlagBlockClkExp = True
                                    End If
                                    hItemBlocked = tVI.hItem
                                    DebugAppend "SetBlockFlag"
                                End If
                            End If
                            DoSetFocus
                            pvSetIPAO
                        End If
                    End If
                End If
    
            Case NM_RCLICK   ' lParam = lp NMHDR
                If nmtv.hdr.hWndFrom = hTVD Then
            
                  ' Get the highlighted treeview item (instead of just TVHT_ONITEM)
                  Call GetCursorPos(PT)
                  Call ScreenToClient(hTVDW, PT)
                  tvhti.PT = PT
                  Call TreeView_HitTest(hTVDW, tvhti)
                  If (tvhti.Flags And TVHT_ONITEMLINE) Then
            
                    ' Get the item's ITEMDATA struct
                    tVI.Mask = TVIF_PARAM
                    tVI.hItem = tvhti.hItem
                    If TreeView_GetItem(hTVDW, tVI) Then
                        TreeView_SelectItem hTVD, tVI.hItem
                        RaiseEvent ItemClick(TVEntries(tVI.lParam).sName, TVEntries(tVI.lParam).sFullPath, TVEntries(tVI.lParam).bFolder, MK_RBUTTON, tvhti.hItem)
                        RaiseEvent ItemClickByShellItem(siSelected, TVEntries(tVI.lParam).sName, TVEntries(tVI.lParam).sFullPath, TVEntries(tVI.lParam).bFolder, MK_RBUTTON, tvhti.hItem)

                         ShowShellContextMenu tVI.lParam
                          DebugAppend "rclick " & GetTVItemText(hTVDW, tvhti.hItem)
                          ShellTreeSubclassProc = 1
                          Exit Function

                     End If
            
                  End If   ' (tvhti.flags And TVHT_ONITEMLINE)
                End If
            Case NM_CUSTOMDRAW
                'As in Explorer, show encrypted filenames in green, compressed in blue
                If nmtv.hdr.hWndFrom = hTVD Then
                    Dim NMTVCD As NMTVCUSTOMDRAW
                    CopyMemory NMTVCD, ByVal lParam, LenB(NMTVCD)
                    With NMTVCD.NMCD
                        Select Case .dwDrawStage
                            Case CDDS_PREPAINT
                                ShellTreeSubclassProc = CDRF_NOTIFYITEMDRAW
                                Exit Function
                            
                            Case CDDS_ITEMPREPAINT
                                NMTVCD.ClrText = TVItemGetDispColor(.lItemlParam)
                                CopyMemory ByVal lParam, NMTVCD, LenB(NMTVCD)
    
                        End Select
                    End With
                End If

        End Select
 
    Case WM_INITMENUPOPUP, WM_DRAWITEM, WM_MEASUREITEM
      On Error Resume Next
      Dim lResult As LongPtr
      If (ICtxMenu3 Is Nothing) = False Then
        Call ICtxMenu3.HandleMenuMsg2(uMsg, wParam, lParam, lResult)
      End If
      If (ICtxMenu2 Is Nothing) = False Then
        Call ICtxMenu2.HandleMenuMsg(uMsg, wParam, lParam)
      End If
End Select

ShellTreeSubclassProc = DefSubclassProc(hwnd, uMsg, wParam, lParam)
'<EhFooter>
Exit Function

e0:
    DebugAppend "ucShellTree.ucWndProc->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
    Resume Next
'</EhFooter>
End Function 'ucWndProc

Private Function FARPROC(lpAdr As LongPtr) As LongPtr
FARPROC = lpAdr
End Function
Private Function Subclass(hWnd As LongPtr, lpFN As LongPtr, Optional uId As LongPtr = 0&, Optional dwRefData As LongPtr = 0&) As Boolean
If uId = 0 Then uId = hWnd
    Subclass = SetWindowSubclass(hWnd, lpFN, uId, dwRefData):      Debug.Assert Subclass
End Function

Private Function UnSubclass(hWnd As LongPtr, ByVal lpFN As LongPtr, pid As LongPtr) As Boolean
    UnSubclass = RemoveWindowSubclass(hWnd, lpFN, pid)
End Function

End Class