vbAccelerator - Contents of code file: vbalTreeView.ctl

VERSION 5.00
Begin VB.UserControl vbalColumnTreeView 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   ToolboxBitmap   =   "vbalTreeView.ctx":0000
End
Attribute VB_Name = "vbalColumnTreeView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' =========================================================================
' vbalColumnTreeView
'
' Implements a Multi-Column TreeView using the API.
'
' Thanks in no particular order for getting this to work:
'
' - Michal Mecinski for the CodeGuru article describing how
'   to implement a multi-column Tree using owner-draw
' - Dan Litwin for the excellent  original TreeView from which
'   this is derived
' - Mike Gainer for demonstrating the IOLEInPlaceActiveObject
'   code
' - Matt Currland/Bill Storage for writing the OLEGuids TypeLib
'   and publishing the info about it to the VB world
' - Jeffery. M Richter for Spy++
' - Brad Martinez for the fantastic IShellFolderEx_TLB TypeLib
' - Bruce McKinney for Hardcore Visual Basic, CopyMemory,
'   ObjectFromPtr, Subclassing and Timer Assistant (even if
'   it was broken...)
' - M83 - Dead Cities
' - LFO - Sheath
' - Marlboro Lights
'
'
' Steve McMahon, 2004, vbAccelerator.com (>>)
'
' =========================================================================

' Parts of this code have been inspired by MFC code by
' Michal Mecinski
'
'   /*********************************************************
'   * Multi-Column Tree View
'   * Version: 1.1
'   * Date: October 22, 2003
'   * Author: Michal Mecinski
'   * E-mail: mimec@mimec.w.pl
'   * WWW: http://www.mimec.w.pl
'   *
'   * Copyright (C) 2003 by Michal Mecinski
'   *********************************************************/
'
' Based on xuiTreeView by Dan Litwin.
'
' Changes here:
'  - Object model for accessing the items
'  - Bug fixes in event handling
'  - More colour properties and global colour settings
'  - Recoded Drag/Drop using VB style OLE methods
'  -

' ///////////////////////////////////////////////////
' //
' //  This was coded by Dan Litwin. Isn't that nice?
' //  litwin@gottliebaza.org is my mail, so send me
' //  anything you want me to take a look at.
' //
' //  About the TreeView, it's a work in progress.
' //  I haven't done Drag-and-Drop yet, nor custom
' //  sorting. FolderTreeView comes later, but I'm
' //  working on it.
' //
' //  This was done with the help of Brad Martinez's
' //  code (http://members.aol.com/btmtz/vb), MFC
' //  stuff at CodeGuru (http://www.codeguru.com/),
' //  and, of course, the guidance of Steve over at
' //  vbAccelerator (/index.html).
' //  To them, I salute.
' //
' //  Now, on with the code!
' //
' ///////////////////////////////////////////////////
' //
' //  But wait! Not yet! How about some darn cool,
' //  brand-spaking new features? Oh, yeah, baby.
' //  Here's some updates for ya...
' //
' //  January, 2000:
' //    - For the new millennium, new stuff.
' //    - I fixed the ExplorerBar code, because Steve
' //      at vbAccelerator didn't like his own version,
' //      said it wasn't elegant. So I tried another way.
' //    - Custom sorting is all implemented. I hijacked
' //      some space from Steve's mIMalloc module to use
' //      for the callback.
' //    - For that same custom sorting, I added a method
' //      for built-in custom sorting to use with the
' //      CustomSort event, called StockCustomSort.
' //    - And, finally, ladies and gents, we have the
' //      Drag and Drop that we've all been waiting for.
' //      Including some nice events to expose it, and a
' //      couple properties for controlling the cool
' //      subfeatures of it.
' //    - There's other stuff in here, just search for
' //      the word "DLL" (my initials) to find them.
' //
' //  Happy hunting!
' //
' ///////////////////////////////////////////////////

' Some standard API junkola.
Private Type POINTAPI
    x As Long
    y As Long
End Type
' This next one I put in to help myself out. Coulda done
' without it, but what the heck, why not?
Private Type DWORD
    LOWORD As Integer
    HIWORD As Integer
End Type
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Declare Function ImageList_Destroy Lib "comctl32.dll" (ByVal hIml As
 Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal
 lpString As String) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As
 Integer
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA"
 (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As
 String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth
 As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long,
 ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect
 As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x
 As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
 bRepaint As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal
 nCmdShow As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal
 hWndNewParent As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
 (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
 (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd
 As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
 hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
' This next one is for the messages that take Long
' values as their lParam, so it passes ByVal.
Private Declare Function SendMessageL Lib "user32" Alias "SendMessageA" (ByVal
 hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
 As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal
 hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
 As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect
 As RECT) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As
 Long, ByVal y As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As
 RECT, ByVal hBrush As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptX As
 Long, ByVal ptY As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
 hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As
 Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long,
 lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long,
 lpPoint As POINTAPI) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal
 crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal
 nBkMode As Long) As Long
   Private Const OPAQUE = 2
   Private Const TRANSPARENT = 1
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal
 crColor As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect
 As RECT) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT,
 ByVal edge As Long, ByVal grfFlags As Long) As Long
   Private Const BDR_SUNKENINNER = &H8
   Private Const BF_RIGHT = &H4
   Private Const BF_BOTTOM = &H8
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long)
 As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal
 nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As
 Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As
 Long, ByVal y As Long) As Long
Private Declare Function GetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal
 nBar As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As
 Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal
 wFormat As Long) As Long
   Private Const DT_BOTTOM = &H8&
   Private Const DT_CENTER = &H1&
   Private Const DT_LEFT = &H0&
   Private Const DT_CALCRECT = &H400&
   Private Const DT_WORDBREAK = &H10&
   Private Const DT_VCENTER = &H4&
   Private Const DT_TOP = &H0&
   Private Const DT_TABSTOP = &H80&
   Private Const DT_SINGLELINE = &H20&
   Private Const DT_RIGHT = &H2&
   Private Const DT_NOCLIP = &H100&
   Private Const DT_NOPREFIX = &H800
   Private Const DT_INTERNAL = &H1000&
   Private Const DT_EXTERNALLEADING = &H200&
   Private Const DT_EXPANDTABS = &H40&
   Private Const DT_CHARSTREAM = 4&
   Private Const DT_WORD_ELLIPSIS = &H40000
   Private Const DT_END_ELLIPSIS = &H8000&
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal
 hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long,
 ByVal cy As Long, ByVal wFlags As Long) As Long
   Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send
    WM_NCCALCSIZE
   Private Const SWP_NOACTIVATE = &H10
   Private Const SWP_NOMOVE = &H2
   Private Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering
   Private Const SWP_NOREDRAW = &H8
   Private Const SWP_NOSIZE = &H1
   Private Const SWP_NOZORDER = &H4
   Private Const SWP_SHOWWINDOW = &H40
   Private Const HWND_TOPMOST = -1
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long,
 lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As
 Long, ByVal y As Long) As Long
Private Type DLLVERSIONINFO
    cbSize As Long
    dwMajor As Long
    dwMinor As Long
    dwBuildNumber As Long
    dwPlatformId As Long
End Type
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal
 lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long)
 As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long,
 ByVal lpProcName As String) As Long
Private Declare Function DllGetVersion Lib "COMCTL32" (pdvi As DLLVERSIONINFO)
 As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR
 As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

' Class name.
Private Const WC_TREEVIEW = "SysTreeView32"

' Some styles and messages.
Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000
Private Const WS_CHILD = &H40000000
Private Const WS_DISABLED = &H8000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_TABSTOP = &H10000
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_CLIENTEDGE = &H200

Private Const WM_SETFOCUS = &H7
Private Const WM_SETREDRAW = &HB
Private Const WM_ERASEBKGND = &H14
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_NOTIFY = &H4E
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_HSCROLL = &H114
Private Const WM_VSCROLL = &H115
    Private Const SB_LINEDOWN = 1
    Private Const SB_LINEUP = 0
Private Const WM_USER = &H400

' mouse activate responses
Private Const MA_ACTIVATE = 1
Private Const MA_ACTIVATEANDEAT = 2
Private Const MA_NOACTIVATE = 3
Private Const MA_NOACTIVATEANDEAT = 4

Private Const SW_HIDE = 0
Private Const SW_SHOW = 1

' All the structures that you could ever ask for!
Private Type NMHDR
    hwndFrom As Long
    idfrom As Long
    code As Long
End Type
Private Type TVITEM
    mask As Long
    hItem As Long
    State As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
End Type
' SPM: for CopyMemory lParam purposes.  The pszText property must be a long
 pointer otherwise VB goes a bit 'funny'
Private Type TVITEM_textptr
    mask As Long
    hItem As Long
    State As Long
    stateMask As Long
    pszText As Long
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
End Type
Private Type TVITEMEX
    mask As Long
    hItem As Long
    State As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
    iIntegral As Long
End Type
Private Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hdc As Long
    rc As RECT
    dwItemSpec As Long ' this is control specific, but it's how to specify an
     item.  valid only with CDDS_ITEM bit set
    uItemState As Long
    lItemlParam As Long
End Type
Private Type NMTVCUSTOMDRAW
    NMCD As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    iLevel As Long
End Type
Private Type TVDISPINFO
    hdr As NMHDR
    Item As TVITEM
End Type
Private Type TVDISPINFO_ptr
    hdr As NMHDR
    Item As TVITEM_textptr
End Type
Private Type TVHITTESTINFO
    pt As POINTAPI
    flags As Long
    hItem As Long
End Type
Private Type NMTREEVIEW
    hdr As NMHDR
    action As Long
    itemOld As TVITEM
    itemNew As TVITEM
    ptDrag As POINTAPI
End Type
Private Type NMTREEVIEW_textptr
   hdr As NMHDR
   action As Long
   itemOld As TVITEM_textptr
   itemNew As TVITEM_textptr
   ptDrag As POINTAPI
End Type
Private Type NMTVGETINFOTIP
    hdr As NMHDR
    pszText As Long
    cchTextMax As Long
    hItem As Long
    lParam As Long
End Type
Private Type TVINSERTSTRUCT
    hParent As Long
    hInsertAfter As Long
    Item As TVITEMEX
End Type
Private Type TVKEYDOWN
    hdr As NMHDR
    wVKey As Integer
    flags1 As Integer
    flags2 As Integer
End Type
Private Type TVSORTCB
    hParent As Long
    lpfnCompare As Long
    lParam As Long
End Type
Private Type NMCHAR
    hdr As NMHDR
    ch As Long
    dwItemPrev As Long
    dwItemNext As Long
End Type

' Common Controls stuff.
Private Const ICC_TREEVIEW_CLASSES = &H2
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (icc As ICCEx)
 As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Type ICCEx
    dwSize As Long          ' size of this structure
    dwICC As Long           ' flags indicating which classes to be initialized
End Type

Private Const CCM_FIRST = &H2000&                   '// Common control shared
 messages
Private Const CCM_SETVERSION = (CCM_FIRST + 7)
Private Const CCM_GETVERSION = (CCM_FIRST + 8)
Private Const CCM_SETNOTIFYWINDOW = (CCM_FIRST + 9)    '// wParam == hwndParent.

' Notification messages.
Private Const NM_FIRST = 0
Private Const NM_CLICK = (NM_FIRST - 2)
Private Const NM_CUSTOMDRAW = (NM_FIRST - 12)
Private Const NM_DBLCLK = (NM_FIRST - 3)
Private Const NM_KILLFOCUS = (NM_FIRST - 8)
Private Const NM_RCLICK = (NM_FIRST - 5)
Private Const NM_RETURN = (NM_FIRST - 4)
Private Const NM_CHAR = (NM_FIRST - 18)                '// uses NMCHAR struct

' Expanding stuff.
Private Const TVE_COLLAPSE = &H1
Private Const TVE_COLLAPSERESET = &H8000
Private Const TVE_EXPAND = &H2
Private Const TVE_EXPANDPARTIAL = &H4000
Private Const TVE_TOGGLE = &H3

Private Const TVC_BYKEYBOARD = &H2
Private Const TVC_BYMOUSE = &H1
Private Const TVC_UNKNOWN = &H0

' TVM_GETNEXTITEM goodies.
Private Const TVGN_CARET = &H9
Private Const TVGN_CHILD = &H4
Private Const TVGN_DROPHILITE = &H8
Private Const TVGN_FIRSTVISIBLE = &H5
Private Const TVGN_LASTVISIBLE = &HA
Private Const TVGN_NEXT = &H1
Private Const TVGN_NEXTVISIBLE = &H6
Private Const TVGN_PARENT = &H3
Private Const TVGN_PREVIOUS = &H2
Private Const TVGN_PREVIOUSVISIBLE = &H7
Private Const TVGN_ROOT = &H0


' The root value. Nice and useful. I return this in
' the Index helper function, when -1 is passed.
Private Const TVI_ROOT = &HFFFF0000

' Inserting stuff.
Private Const TVI_FIRST = &HFFFF0001
Private Const TVI_LAST = &HFFFF0002
Private Const TVI_SORT = &HFFFF0003

' Mask values.
Private Const TVIF_CHILDREN = &H40
Private Const TVIF_DI_SETITEM = &H1000
Private Const TVIF_HANDLE = &H10
Private Const TVIF_IMAGE = &H2
Private Const TVIF_INTEGRAL = &H80
Private Const TVIF_PARAM = &H4
Private Const TVIF_SELECTEDIMAGE = &H20
Private Const TVIF_STATE = &H8
Private Const TVIF_TEXT = &H1

' More mask values, of the state kind.
Private Const TVIS_BOLD = &H10
Private Const TVIS_CUT = &H4
Private Const TVIS_DROPHILITED = &H8
Private Const TVIS_EXPANDED = &H20
Private Const TVIS_EXPANDEDONCE = &H40
Private Const TVIS_EXPANDPARTIAL = &H80
Private Const TVIS_OVERLAYMASK = &HF00
Private Const TVIS_SELECTED = &H2
Private Const TVIS_STATEIMAGEMASK = &HF000
Private Const TVIS_USERMASK = &HF000

' TreeView messages.
Private Const TV_FIRST = &H1100
Private Const TVM_CREATEDRAGIMAGE = (TV_FIRST + 18)
Private Const TVM_DELETEITEM = (TV_FIRST + 1)
Private Const TVM_EDITLABEL = (TV_FIRST + 14)
Private Const TVM_ENDEDITLABELNOW = (TV_FIRST + 22)
Private Const TVM_ENSUREVISIBLE = (TV_FIRST + 20)
Private Const TVM_EXPAND = (TV_FIRST + 2)
Private Const TVM_GETBKCOLOR = (TV_FIRST + 31)
Private Const TVM_GETBORDER = (TV_FIRST + 36)
Private Const TVM_GETCOUNT = (TV_FIRST + 5)
Private Const TVM_GETEDITCONTROL = (TV_FIRST + 15)
Private Const TVM_GETIMAGELIST = (TV_FIRST + 8)
Private Const TVM_GETINDENT = (TV_FIRST + 6)
Private Const TVM_GETISEARCHSTRINGA = (TV_FIRST + 23)
Private Const TVM_GETITEM = (TV_FIRST + 12)
Private Const TVM_GETITEMHEIGHT = (TV_FIRST + 28)
Private Const TVM_GETITEMRECT = (TV_FIRST + 4)
Private Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Private Const TVM_GETSCROLLTIME = (TV_FIRST + 34)
Private Const TVM_GETTEXTCOLOR = (TV_FIRST + 32)
Private Const TVM_GETTOOLTIPS = (TV_FIRST + 25)
Private Const TVM_GETVISIBLECOUNT = (TV_FIRST + 16)
Private Const TVM_HITTEST = (TV_FIRST + 17)
Private Const TVM_INSERTITEM = (TV_FIRST + 0)
Private Const TVM_SELECTITEM = (TV_FIRST + 11)
Private Const TVM_SETBKCOLOR = (TV_FIRST + 29)
Private Const TVM_SETBORDER = (TV_FIRST + 35)
Private Const TVM_SETIMAGELIST = (TV_FIRST + 9)
Private Const TVM_SETINDENT = (TV_FIRST + 7)
Private Const TVM_SETINSERTMARK = (TV_FIRST + 26)
Private Const TVM_SETITEM = (TV_FIRST + 13)
Private Const TVM_SETITEMHEIGHT = (TV_FIRST + 27)
Private Const TVM_SETSCROLLTIME = (TV_FIRST + 33)
Private Const TVM_SETTEXTCOLOR = (TV_FIRST + 30)
Private Const TVM_SETTOOLTIPS = (TV_FIRST + 24)
Private Const TVM_SORTCHILDREN = (TV_FIRST + 19)
Private Const TVM_SORTCHILDRENCB = (TV_FIRST + 21)
Private Const TVM_SETLINECOLOR = (TV_FIRST + 40)
Private Const TVM_GETLINECOLOR = (TV_FIRST + 41)


' TreeView notifications, telling us what's going down.
Private Const TVN_FIRST = -400 ' SPM :) it's negative...
Private Const TVN_BEGINLABELEDIT = (TVN_FIRST - 10)
Private Const TVN_BEGINDRAG = (TVN_FIRST - 7)
Private Const TVN_BEGINRDRAG = (TVN_FIRST - 8)
Private Const TVN_DELETEITEM = (TVN_FIRST - 9)
Private Const TVN_GETDISPINFO = (TVN_FIRST - 3)
Private Const TVN_GETINFOTIP = (TVN_FIRST - 13)
Private Const TVN_KEYDOWN = (TVN_FIRST - 12)
Private Const TVN_ENDLABELEDIT = (TVN_FIRST - 11)
Private Const TVN_ITEMEXPANDED = (TVN_FIRST - 6)
Private Const TVN_ITEMEXPANDING = (TVN_FIRST - 5)
Private Const TVN_SELCHANGED = (TVN_FIRST - 2)
Private Const TVN_SELCHANGING = (TVN_FIRST - 1)
Private Const TVN_SINGLEEXPAND = (TVN_FIRST - 15)

' TreeView specific styles.
Private Const TVS_CHECKBOXES = &H100
Private Const TVS_DISABLEDRAGDROP = &H10
Private Const TVS_EDITLABELS = &H8
Private Const TVS_FULLROWSELECT = &H1000
Private Const TVS_HASBUTTONS = &H1
Private Const TVS_HASLINES = &H2
Private Const TVS_INFOTIP = &H800
Private Const TVS_LINESATROOT = &H4
Private Const TVS_NOSCROLL = &H2000
Private Const TVS_NOTOOLTIPS = &H80
Private Const TVS_SHOWSELALWAYS = &H20
Private Const TVS_SINGLEEXPAND = &H400
Private Const TVS_TRACKSELECT = &H200
Private Const TVS_NONEVENHEIGHT = &H4000&
Private Const TVS_NOHSCROLL = &H8000&

' TVHT_* hit testing codes
Private Const TVHT_NOWHERE = &H1
Private Const TVHT_ONITEMICON = &H2
Private Const TVHT_ONITEMLABEL = &H4
Private Const TVHT_ONITEMINDENT = &H8
Private Const TVHT_ONITEMBUTTON = &H10
Private Const TVHT_ONITEMRIGHT = &H20
Private Const TVHT_ONITEMSTATEICON = &H40
Private Const TVHT_ONITEM = (TVHT_ONITEMICON Or TVHT_ONITEMLABEL Or
 TVHT_ONITEMSTATEICON)

Private Const TVHT_ABOVE = &H100
Private Const TVHT_BELOW = &H200
Private Const TVHT_TORIGHT = &H400
Private Const TVHT_TOLEFT = &H800


' These next ones are for TVM_*ETBORDER, which is
' exposed in the InternalBorder properties.
Private Const TVSBF_XBORDER = &H1
Private Const TVSBF_YBORDER = &H2

' ImageList type values. (Wonder what 1 is?)
Private Const TVSIL_NORMAL = 0
Private Const TVSIL_STATE = 2

' CustomDraw paint stages.
Private Const CDDS_ITEM = &H10000
Private Const CDDS_POSTERASE = &H4
Private Const CDDS_POSTPAINT = &H2
Private Const CDDS_PREERASE = &H3
Private Const CDDS_PREPAINT = &H1
Private Const CDDS_ITEMPREPAINT = (&H10000 Or &H1)
Private Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)
Private Const CDDS_SUBITEM = &H20000

' CustomDraw Item states.
Private Const CDIS_SELECTED = &H1
Private Const CDIS_GRAYED = &H2
Private Const CDIS_DISABLED = &H4
Private Const CDIS_CHECKED = &H8
Private Const CDIS_FOCUS = &H10
Private Const CDIS_DEFAULT = &H20
Private Const CDIS_HOT = &H40
Private Const CDIS_MARKED = &H80
Private Const CDIS_INDETERMINATE = &H100

' CustomDraw return values.
Private Const CDRF_DODEFAULT = &H0
Private Const CDRF_NEWFONT = &H2
Private Const CDRF_SKIPDEFAULT = &H4

Private Const CDRF_NOTIFYITEMDRAW = &H20
Private Const CDRF_NOTIFYPOSTERASE = &H40
Private Const CDRF_NOTIFYPOSTPAINT = &H10
Private Const CDRF_NOTIFYSUBITEMDRAW = &H20

' Other miskulanius (miscellaneous) messages.
Private Const WM_GETFONT = &H31
Private Const WM_SETFONT = &H30
Private Const TTM_GETTIPBKCOLOR = (WM_USER + 22)
Private Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)

' See KB Q261289
Private Const UM_CHECKSTATECHANGED = WM_USER + &H112
'
Private Const UM_STARTDRAG = WM_USER + &H113


Public Enum ETreeViewRelationshipContants
   etvwFirst
   etvwLast
   etvwNext
   etvwPrevious
   etvwChild
End Enum

Public Enum ETreeViewLineStyleConstants
   etvwRootLines
   etvwTreeLines
End Enum

Public Enum ETreeViewStyleConstants
   etvwTextOnly
   etvwPictureText
   etvwPlusMinusText
   etvwPlusMinusPictureText
   etvwTreelinesText
   etvwTreelinesPlusMinusText
   etvwTreelinesPictureText
   etvwTreelinesPlusMinusPictureText
End Enum

Public Enum ETreeViewHitTestConstants
   etvwHitTestAbove = &H100
   etvwHitTestBelow = &H200
   etvwHitTestBelowLast = &H1
   etvwHitTestItemPlusMinus = &H10
   etvwHitTestItemIcon = &H2
   etvwHitTestItemIndent = &H8
   etvwHitTestItemText = &H4
   etvwHitTestItemRight = &H20
   etvwHitTestItemState = &H40
   etvwHitTestLeft = &H800
   etvwHitTestRight = &H400
End Enum

Public Enum ETreeViewBorderStyle
   etvwNone = 0
   etvwFixedSingle = 1
End Enum

Public Enum ETreeViewChildrenSortMode
   etvwNoSort = 0
   etvwAlphabetic = 1
   etvwItemDataThenAlphabetic = 2
   etvwTagThenAlphabetic = 3
   etvwCustomSortEvent = 4
End Enum

Public Enum ETreeViewSortResult
   etvwItem1PreceedsItem2 = -1
   etvwItem1EqualsItem2 = 0
   etvwItem1FollowsItem2 = 1
End Enum

Public Enum ETreeViewDragInsertStyle
   etvwInsertMark = 0
   etvwDropHighlight = 1
End Enum

Public Event AfterLabelEdit(ByRef node As cCTreeViewNode, ByRef NewString As
 String, ByRef cancel As Boolean)
Public Event BeforeCollapse(node As cCTreeViewNode, ByRef cancel As Boolean)
Public Event BeforeExpand(node As cCTreeViewNode, ByRef cancel As Boolean)
Public Event BeforeLabelEdit(ByRef node As cCTreeViewNode, ByRef cancel As
 Boolean)
Public Event Click()
Attribute Click.VB_Description = "Raised when the control is clicked."
Public Event Collapse(node As cCTreeViewNode)
Public Event DblClick()
Attribute DblClick.VB_Description = "Raised when the control is double-clicked."
Public Event Expand(node As cCTreeViewNode)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_Description = "Raised when a key is depressed in the
 control."
Public Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_Description = "Raised when a key is pressed in the
 control."
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_Description = "Raised when a key is released in the control."
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As
 Single)
Attribute MouseDown.VB_Description = "Raised when a mouse button is depressed
 in the control."
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As
 Single)
Attribute MouseMove.VB_Description = "Raised when the mouse moves over the
 control."
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As
 Single)
Attribute MouseUp.VB_Description = "Raised when the mouse is released over the
 control (not supported by the TreeView)."
Public Event nodeCheck(node As cCTreeViewNode)
Public Event NodeClick(node As cCTreeViewNode)
Public Event NodeDblClick(node As cCTreeViewNode)
Public Event NodeRightClick(node As cCTreeViewNode)
Public Event OLECompleteDrag(Effect As Long)
Attribute OLECompleteDrag.VB_Description = "Raised when an OLE drag-drop
 operation completes."
Public Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer,
 Shift As Integer, x As Single, y As Single)
Attribute OLEDragDrop.VB_Description = "Raised when an item is dropped during a
 DragDrop operation."
Public Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer,
 Shift As Integer, x As Single, y As Single, State As Integer)
Attribute OLEDragOver.VB_Description = "Raised when an OLE Drag Over event
 occurs."
Public Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
Attribute OLEGiveFeedback.VB_Description = "Raised during an OLE Drag operation
 when visual feedback is required."
Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Long)
Attribute OLEStartDrag.VB_Description = "Raised when an OLE Drag-Drop operation
 is about to start from this control."
Public Event DragDropRequest(Data As DataObject, nodeOver As cCTreeViewNode,
 ByVal bAbove As Boolean, ByVal hitTest As Long)
Public Event CustomSort(node1 As cCTreeViewNode, node2 As cCTreeViewNode,
 nodeParent As cCTreeViewNode, ByRef iCompareResult As ETreeViewSortResult)

Public Event SelectedNodeChanged()
Attribute SelectedNodeChanged.VB_Description = "Raised when the selected node
 in the control is changed."

Implements ISubclass

' TreeView control
Private m_hWnd As Long
Private m_hWndParent As Long
Private m_bTerminate As Boolean
Private m_bSubclassed As Boolean
Private m_IPAOHookStruct As IPAOHookStruct
Private m_hMod As Long
' hWNd of Edit control in TreeView
Private m_hEdit As Long

Private m_bClearing As Boolean
Private m_bDragging As Boolean

' ComCtl version
Private m_lMajor As Long
Private m_lMinor As Long

' Style related
Private m_eTreeViewStyle As ETreeViewStyleConstants
Private m_bCheckBoxes As Boolean
Private m_bFullRowSelect As Boolean
Private m_bScroll As Boolean
Private m_bHideSelection  As Boolean
Private m_bEnabled As Boolean
Private m_eLineStyle As ETreeViewLineStyleConstants
Private m_bSingleSel As Boolean
Private m_eBorderStyle As ETreeViewBorderStyle
Private m_bLabelEdit As Boolean
Private m_eDragStyle As ETreeViewDragInsertStyle
Private m_bGridLines As Boolean

' Sizes
Private m_lItemHeight As Long
Private m_lIndent As Long

' Colours
Private m_oBackColor As OLE_COLOR
Private m_oForeColor As OLE_COLOR
Private m_oLineColor As OLE_COLOR
Private m_oTooltipBackColor As OLE_COLOR
Private m_oTooltipForeColor As OLE_COLOR
Private m_oSelectedForeColor As OLE_COLOR
Private m_oSelectedBackColor As OLE_COLOR
Private m_oSelectedNoFocusForeColor As OLE_COLOR
Private m_oSelectedNoFocusBackColor As OLE_COLOR
Private m_oSelectedMouseOverForeColor As OLE_COLOR
Private m_oSelectedMouseOverBackColor As OLE_COLOR
Private m_oMouseOverForeColor As OLE_COLOR
Private m_oMouseOverBackColor As OLE_COLOR
Private m_fnt As IFont
Private m_eCurrentSortMode As ETreeViewChildrenSortMode

' General
Private m_sTag As String
Private m_sPathSeparator As String

' Internal storage:
Private Type tTreeViewInfoStore
   hRel As Long
   
   ItemColor As Long
   bDoColor As Boolean
   
   ItemBackColor As Long
   bDoBackColor As Boolean
   
   ItemMouseOverColor As Long
   bDoMouseOverColor As Boolean
   
   ItemMouseOverBackColor As Long
   bDoMouseOverBackColor As Boolean
   
   ItemSelectedMouseOverColor As Long
   bDoSelectedMouseOverColor As Boolean
   
   ItemSelectedMouseOverBackColor As Long
   bDoSelectedMouseOverBackColor As Boolean
   
   ItemSelectedColor As Long
   bDoSelectedColor As Boolean
   
   ItemSelectedBackColor As Long
   bDoSelectedBackColor As Boolean
      
   ItemSelectedNoFocusColor As Long
   bDoSelectedNoFocusColor As Boolean
   
   ItemSelectedNoFocusBackColor As Long
   bDoSelectedNoFocusBackColor As Boolean
   
   ItemFont As Long
   bDoFont As Boolean
   
   eSortMode As ETreeViewChildrenSortMode
      
   ItemData As Long
   ItemNumber As Long
   lID As Long          ' ID from hRel
   
   SubItemCount As Long ' Number of sub items
   lPtrSubItems As Long ' ObjPtr to class holding sub itmes
   
End Type

Private m_colData As New Collection
Private m_fntItem() As IFont
Private m_lFontCount As Long

' obtain a key from a hRel:
Private m_colKeys As New Collection
' obtain a hRel from the Key:
Private m_colIndexes As New Collection
' Obtain an hRel from an ID
Private m_colIDs As New Collection
' Obtain a Tag from an ID
Private m_colTags As New Collection

' This holds the values every time we use GetStyle and SetIStyle.
Private m_itemStyle As TVITEMEX

' Drag-drop
Private m_eOLEDragMode As OLEDragConstants

Private WithEvents m_cHeader As cHeaderControl
Attribute m_cHeader.VB_VarHelpID = -1
Private WithEvents m_cScroll As cScrollBars
Attribute m_cScroll.VB_VarHelpID = -1

Private m_hDragItem As Long
Private m_bStartDrag As Boolean
Private m_hDragOver As Long
Private m_hItemInsert As Long
Private m_bItemInsertAbove As Boolean
Private m_cImageListDrag As pcImageListDrag
Private m_hIml As Long
Private m_bDragAutoExpand As Long
Private WithEvents tmrDragScroll As CTimer
Attribute tmrDragScroll.VB_VarHelpID = -1
Private WithEvents tmrDragAutoExpand As CTimer
Attribute tmrDragAutoExpand.VB_VarHelpID = -1
Private WithEvents tmrDragNoMore As CTimer
Attribute tmrDragNoMore.VB_VarHelpID = -1

Public Property Get GridLines() As Boolean
   GridLines = m_bGridLines
End Property
Public Property Let GridLines(ByVal bState As Boolean)
   If Not (m_bGridLines = bState) Then
      m_bGridLines = bState
      Refresh
   End If
   PropertyChanged "GridLines"
End Property

Public Property Get DragStyle() As ETreeViewDragInsertStyle
Attribute DragStyle.VB_Description = "Gets/sets the drag style for the control.
  In insert mode, the order of children can be modified, whereas in
 drop-highlight mode only an item's parent can be changed."
   DragStyle = m_eDragStyle
End Property
Public Property Let DragStyle(ByVal eStyle As ETreeViewDragInsertStyle)
   If Not (m_eDragStyle = eStyle) Then
      m_eDragStyle = eStyle
      PropertyChanged "DragStyle"
   End If
End Property

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Gets/sets the background colour of the
 treeview."
   BackColor = m_oBackColor
End Property
Public Property Let BackColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oBackColor) Then
      m_oBackColor = Value
      UserControl.BackColor = m_oBackColor
      If Not (m_hWnd = 0) Then
         SendMessageL m_hWnd, TVM_SETBKCOLOR, 0, TranslateColor(Value)
      End If
      PropertyChanged "BackColor"
   End If
End Property

Public Property Get SelectedBackColor() As OLE_COLOR
Attribute SelectedBackColor.VB_Description = "Gets the default background
 colour for selected items."
   SelectedBackColor = m_oSelectedBackColor
End Property
Public Property Let SelectedBackColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oSelectedBackColor) Then
      m_oSelectedBackColor = Value
      PropertyChanged "SelectedBackColor"
   End If
End Property

Public Property Get SelectedForeColor() As OLE_COLOR
Attribute SelectedForeColor.VB_Description = "Gets the default foreground
 colour for selected items."
   SelectedForeColor = m_oSelectedForeColor
End Property
Public Property Let SelectedForeColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oSelectedForeColor) Then
      m_oSelectedForeColor = Value
      PropertyChanged "SelectedForeColor"
   End If
End Property

Public Property Get SelectedNoFocusBackColor() As OLE_COLOR
Attribute SelectedNoFocusBackColor.VB_Description = "Gets the default
 background colour for selected items when the control is out of focus."
   SelectedNoFocusBackColor = m_oSelectedNoFocusBackColor
End Property
Public Property Let SelectedNoFocusBackColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oSelectedNoFocusBackColor) Then
      m_oSelectedNoFocusBackColor = Value
      PropertyChanged "SelectedNoFocusBackColor"
   End If
End Property

Public Property Get SelectedNoFocusForeColor() As OLE_COLOR
Attribute SelectedNoFocusForeColor.VB_Description = "Gets the default
 foreground colour for selected items when the control is out of focus."
   SelectedNoFocusForeColor = m_oSelectedNoFocusForeColor
End Property
Public Property Let SelectedNoFocusForeColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oSelectedNoFocusForeColor) Then
      m_oSelectedNoFocusForeColor = Value
      PropertyChanged "SelectedNoFocusForeColor"
   End If
End Property

Public Property Get SelectedMouseOverBackColor() As OLE_COLOR
Attribute SelectedMouseOverBackColor.VB_Description = "Gets the default
 background colour for selected items when the mouse is over them."
   SelectedMouseOverBackColor = m_oSelectedMouseOverBackColor
End Property
Public Property Let SelectedMouseOverBackColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oSelectedMouseOverBackColor) Then
      m_oSelectedMouseOverBackColor = Value
      PropertyChanged "SelectedMouseOverBackColor"
   End If
End Property

Public Property Get SelectedMouseOverForeColor() As OLE_COLOR
Attribute SelectedMouseOverForeColor.VB_Description = "Gets the default
 foreground colour for selected items when the mouse is over them."
   SelectedMouseOverForeColor = m_oSelectedMouseOverForeColor
End Property
Public Property Let SelectedMouseOverForeColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oSelectedMouseOverForeColor) Then
      m_oSelectedMouseOverForeColor = Value
      PropertyChanged "SelectedMouseOverForeColor"
   End If
End Property

Public Property Get MouseOverBackColor() As OLE_COLOR
Attribute MouseOverBackColor.VB_Description = "Gets/sets the default background
 colour used to draw items when the mouse is over them."
   MouseOverBackColor = m_oMouseOverBackColor
End Property
Public Property Let MouseOverBackColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oMouseOverBackColor) Then
      m_oMouseOverBackColor = Value
      PropertyChanged "MouseOverBackColor"
   End If
End Property

Public Property Get MouseOverForeColor() As OLE_COLOR
Attribute MouseOverForeColor.VB_Description = "Gets/sets the default foreground
 colour used to draw items when the mouse is over them."
   MouseOverForeColor = m_oMouseOverForeColor
End Property
Public Property Let MouseOverForeColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oMouseOverForeColor) Then
      m_oMouseOverForeColor = Value
      PropertyChanged "MouseOverForeColor"
   End If
End Property
Public Property Get BorderStyle() As ETreeViewBorderStyle
Attribute BorderStyle.VB_Description = "Gets/sets the border style used for the
 control."
   BorderStyle = m_eBorderStyle
End Property
Public Property Let BorderStyle(ByVal Value As ETreeViewBorderStyle)
   If Not (m_eBorderStyle = Value) Then
      m_eBorderStyle = Value
      UserControl.BorderStyle = Value
      PropertyChanged "BorderStyle"
   End If
End Property

Public Property Get CheckBoxes() As Boolean
Attribute CheckBoxes.VB_Description = "Gets/sets whether the control shows
 CheckBoxes next to items."
   CheckBoxes = m_bCheckBoxes
End Property
Public Property Let CheckBoxes(ByVal Value As Boolean)
   If Not (m_bCheckBoxes = Value) Then
      m_bCheckBoxes = Value
      pSetStyles
      PropertyChanged "CheckBoxes"
   End If
End Property

Public Property Get DragAutoExpand() As Boolean
Attribute DragAutoExpand.VB_Description = "Gets/sets whether items will
 automatically expand during drag operations when the mouse hovers over them."
   DragAutoExpand = m_bDragAutoExpand
End Property
Public Property Let DragAutoExpand(ByVal Value As Boolean)
   If Not (m_bDragAutoExpand = Value) Then
      m_bDragAutoExpand = Value
      PropertyChanged "DragAutoExpand"
   End If
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Gets/sets whether the control is Enabled or
 not."
   Enabled = m_bEnabled
End Property
Public Property Let Enabled(ByVal Value As Boolean)
   If (Not (m_bEnabled = Value)) Then
      m_bEnabled = Value
      UserControl.Enabled = m_bEnabled
      PropertyChanged "Enabled"
   End If
End Property

Public Property Get Font() As IFont
Attribute Font.VB_Description = "Gets/sets the font used to draw the items."
   Set m_fnt = UserControl.Font
   Set Font = m_fnt
End Property
Public Property Let Font(Value As IFont)
   '
   Set m_fnt = Value
   Set UserControl.Font = m_fnt
   If Not (m_hWnd = 0) Then
      SendMessageL m_hWnd, WM_SETFONT, m_fnt.hFont, 1
      If Not (m_cHeader Is Nothing) Then
         m_cHeader.SetFont UserControl.hdc, m_fnt
      End If
      PropertyChanged "Font"
   End If
   '
End Property
Public Property Set Font(Value As IFont)
   '
   Set m_fnt = Value
   Set UserControl.Font = m_fnt
   If Not (m_hWnd = 0) Then
      SendMessageL m_hWnd, WM_SETFONT, m_fnt.hFont, 1
      If Not (m_cHeader Is Nothing) Then
         m_cHeader.SetFont UserControl.hdc, m_fnt
      End If
      PropertyChanged "Font"
   End If
   '
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Gets the default foreground colour of the
 items."
   ForeColor = m_oForeColor
End Property
Public Property Let ForeColor(ByVal Value As OLE_COLOR)
   If Not (m_oForeColor = Value) Then
      m_oForeColor = Value
      SendMessageL m_hWnd, TVM_SETTEXTCOLOR, 0, TranslateColor(Value)
      PropertyChanged "ForeColor"
   End If
End Property

Public Property Get FullRowSelect() As Boolean
Attribute FullRowSelect.VB_Description = "Gets/sets whether the selection box
 for an item extends the full width of the control or not."
   FullRowSelect = m_bFullRowSelect
End Property
Public Property Let FullRowSelect(ByVal Value As Boolean)
   If Not (m_bFullRowSelect = Value) Then
      m_bFullRowSelect = Value
      pSetStyles
      PropertyChanged "FullRowSelect"
   End If
End Property

Public Function GetVisibleCount() As Long
Attribute GetVisibleCount.VB_Description = "Gets the number of visible nodes in
 the TreeView."
   '
   GetVisibleCount = SendMessageL(m_hWnd, TVM_GETVISIBLECOUNT, 0, 0)
   '
End Function

Public Property Get HideSelection() As Boolean
Attribute HideSelection.VB_Description = "Gets/sets whether the selected node
 is hidden when the control is out of focus."
   HideSelection = m_bHideSelection
End Property
Public Property Let HideSelection(ByVal Value As Boolean)
   If Not (m_bHideSelection = Value) Then
      m_bHideSelection = Value
      pSetStyles
      PropertyChanged "HideSelection"
   End If
End Property

Public Function hitTest(ByVal x As Single, ByVal y As Single) As cCTreeViewNode
Attribute hitTest.VB_Description = "Gets the Node at the specified position."
   '
Dim tVHT As TVHITTESTINFO
Dim lID As Long

   fUnScale x, y, tVHT.pt.x, tVHT.pt.y
   SendMessage m_hWnd, TVM_HITTEST, 0, tVHT
   If Not (tVHT.hItem = 0) Then
      lID = fIDForhItem(tVHT.hItem)
      Dim nod As New cCTreeViewNode
      nod.fInit Me, lID
      Set hitTest = nod
   End If
   '
End Function

Public Function HitTestInfo(ByVal x As Single, ByVal y As Single) As
 ETreeViewHitTestConstants
Attribute HitTestInfo.VB_Description = "Gets the node at the specified position
 and returns information about which area of the node is under the position."
Dim tVHT As TVHITTESTINFO
Dim lID As Long

   fUnScale x, y, tVHT.pt.x, tVHT.pt.y
   SendMessage m_hWnd, TVM_HITTEST, 0, tVHT
   HitTestInfo = tVHT.flags
   '
End Function

Public Property Get hwnd() As Long
Attribute hwnd.VB_Description = "Gets the hWnd of this control."
   hwnd = UserControl.hwnd
End Property

Public Property Get hWndTreeView() As Long
Attribute hWndTreeView.VB_Description = "Gets the hWnd of the TreeView
 contained within this control."
   hWndTreeView = m_hWnd
End Property

Public Property Let ImageList(Value As Variant)
Attribute ImageList.VB_Description = "Associates an ImageList handle with the
 TreeView used to draw the node images."
Dim hIml As Long
   '
    If (VarType(Value) = vbLong) Then
      ' Assume a handle to an image list:
      hIml = Value
   ElseIf (VarType(hIml) = vbObject) Then
      ' Assume a VB image list:
      On Error Resume Next
      ' Get the image list initialised..
      Value.ListImages(1).Draw 0, 0, 0, 1
      hIml = Value.hImagelist
      If (Err.Number = 0) Then
          ' OK
      Else
          gErr 4, "vbalColumnTreeViewCtl"
      End If
      On Error GoTo 0
   End If
   
   If Not (hIml = 0) Then
      SendMessageL m_hWnd, TVM_SETIMAGELIST, TVSIL_NORMAL, hIml
   End If
   '
End Property

Public Property Get Indentation() As Long
Attribute Indentation.VB_Description = "Gets/sets the indentation."
   Indentation = m_lIndent
End Property
Public Property Let Indentation(ByVal Value As Long)
   If Not (m_lIndent = Value) Then
      m_lIndent = Value
      If Not (m_hWnd = 0) Then
         SendMessageL m_hWnd, TVM_SETINDENT, m_lIndent, 0
      End If
      PropertyChanged "Indentation"
   End If
End Property

Public Property Get ItemHeight() As Long
Attribute ItemHeight.VB_Description = "Gets the height of individual items in
 the TreeView."
   ItemHeight = m_lItemHeight
End Property
Public Property Let ItemHeight(ByVal Value As Long)
   If Not (Value = m_lItemHeight) Then
      m_lItemHeight = Value
      SendMessageL m_hWnd, TVM_SETITEMHEIGHT, m_lItemHeight, 0
      PropertyChanged "ItemHeight"
   End If
End Property

Public Property Get LabelEdit() As Boolean
Attribute LabelEdit.VB_Description = "Gets/sets whether items in the TreeView
 can be edited or not."
   LabelEdit = m_bLabelEdit
End Property
Public Property Let LabelEdit(ByVal Value As Boolean)
   If Not (m_bLabelEdit = Value) Then
      m_bLabelEdit = Value
      pSetStyles
      PropertyChanged "LabelEdit"
   End If
End Property

Public Property Get LineColor() As OLE_COLOR
Attribute LineColor.VB_Description = "Gets/sets the colour of the lines in the
 TreeView."
   LineColor = m_oLineColor
End Property
Public Property Let LineColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oLineColor) Then
      m_oLineColor = Value
      SendMessageL m_hWnd, TVM_SETLINECOLOR, 0, TranslateColor(Value)
      PropertyChanged "LineColor"
   End If
End Property

Public Property Get LineStyle() As ETreeViewLineStyleConstants
Attribute LineStyle.VB_Description = "Gets/sets the line style used in the
 TreeView."
   LineStyle = m_eLineStyle
End Property
Public Property Let LineStyle(ByVal Value As ETreeViewLineStyleConstants)
   If Not (m_eLineStyle = Value) Then
      m_eLineStyle = Value
      pSetStyles
      PropertyChanged "LineStyle"
   End If
End Property

Public Property Get DragInsertNode() As cCTreeViewNode
Attribute DragInsertNode.VB_Description = "During a drag-drop operation,
 returns the node associated with the current drag-drop location."
   If Not (m_hItemInsert = 0) Then
      Dim lID As Long
      lID = fIDForhItem(m_hItemInsert)
      If Not (lID = 0) Then
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         Set DragInsertNode = cNod
      End If
   End If
End Property

Public Property Get DragInsertAbove() As Boolean
Attribute DragInsertAbove.VB_Description = "During drag-drop operations, gets
 whether the current drag-drop location is above the DragInsertMode or not."
   DragInsertAbove = m_bItemInsertAbove
End Property

Public Property Get NodeFromDragData(Data As DataObject) As cCTreeViewNode
Attribute NodeFromDragData.VB_Description = "Gets the Node stored in the Data
 parameter of an Ole Drag/Drop event, if any."
Dim hItem As Long
Dim lID As Long
Dim lErr As Long
Dim hwnd As Long
Dim cNod As New cCTreeViewNode

   If (m_bStartDrag And Not (m_hDragItem = 0)) Then
      lID = fIDForhItem(m_hDragItem)
      If Not (lID = 0) Then
         cNod.fInit Me, lID
         Set NodeFromDragData = cNod
      End If
   Else

      hItem = hItemFromDragData(Data, hwnd)
      If Not (hwnd = UserControl.hwnd) Then
         If Not (IsWindow(hwnd) = 0) Then
            Dim lPtr As Long
            Dim ctl As vbalColumnTreeView
            lPtr = GetProp(hwnd, gcOBJECT_PROP)
            Set ctl = ObjectFromPtr(lPtr)
            Set NodeFromDragData = ctl.NodeFromDragData(Data)
         End If
      Else
         lID = fIDForhItem(hItem)
         If Not (lID = 0) Then
            cNod.fInit Me, lID
            Set NodeFromDragData = cNod
         End If
      End If
      
   End If
   
End Property

Private Function hItemFromDragData(Data As DataObject, ByRef hwnd As Long) As
 Long
Dim hItem As Long
Dim b() As Byte
Dim ihWndPos As Long
Dim ihItemPos As Long
Dim hWndForItem As Long
Dim lPtr As Long

   hwnd = 0

   On Error Resume Next
   b = Data.GetData(&HFFFFB045) ' gcOLE_DATA_FORMAT)
   Dim s As String
   On Error GoTo 0
   s = b
   
   If Len(s) > 6 Then
      ihWndPos = InStr(s, "H:")
      If (ihWndPos = 1) Then
         ihItemPos = InStr(s, ";I:")
         If (ihItemPos >= 4) Then
            On Error Resume Next
            ' Try to interpret hWnd and Item:
            hWndForItem = CLng(Mid(s, 3, ihItemPos - 3))
            hItem = CLng(Mid(s, ihItemPos + 3))
            On Error GoTo 0
            
            If Not (hWndForItem = 0) And Not (hItem = 0) Then
               If (hWndForItem = UserControl.hwnd) Then
                  ' This hItem belongs to me
                  hwnd = UserControl.hwnd
                  hItemFromDragData = hItem
               Else
                  ' It doesn't
                  hwnd = hWndForItem
                  hItemFromDragData = hItem
               End If
            End If
         End If
      End If
   End If
      
End Function

Public Property Get Nodes() As cCTreeViewNodes
Attribute Nodes.VB_Description = "Gets the root collection of nodes in the
 TreeView."
   Dim cN As New cCTreeViewNodes
   cN.fInit Me, 0
   Set Nodes = cN
End Property

Public Property Get Columns() As cCTreeViewColumns
   Dim cC As New cCTreeViewColumns
   cC.fInit Me
   Set Columns = cC
End Property

Public Property Get OLEDragMode() As OLEDragConstants
Attribute OLEDragMode.VB_Description = "Gets/sets the drag mode for the
 control."
   OLEDragMode = m_eOLEDragMode
End Property
Public Property Let OLEDragMode(ByVal eMode As OLEDragConstants)
   m_eOLEDragMode = eMode
   PropertyChanged "OLEDragMode"
End Property
Public Property Get OLEDropMode() As OLEDropConstants
Attribute OLEDropMode.VB_Description = "Gets/sets the OLE Drop Mode of the
 control."
   OLEDropMode = UserControl.OLEDropMode
End Property
Public Property Let OLEDropMode(ByVal eMode As OLEDropConstants)
   UserControl.OLEDropMode = eMode
   PropertyChanged "OLEDropMode"
End Property
Public Property Get ScaleMode() As ScaleModeConstants
Attribute ScaleMode.VB_Description = "Gets the scale mode of the control."
   ScaleMode = UserControl.ScaleMode
End Property
Public Property Let ScaleMode(ByVal eMode As ScaleModeConstants)
   UserControl.ScaleMode = eMode
   PropertyChanged "ScaleMode"
End Property
Public Property Get ScaleWidth() As Single
Attribute ScaleWidth.VB_Description = "Gets the scaled width of the control."
   ScaleWidth = UserControl.ScaleWidth
End Property
Public Property Get ScaleHeight() As Single
Attribute ScaleHeight.VB_Description = "Gets the Scaled height of the control."
   ScaleHeight = UserControl.ScaleHeight
End Property
Public Property Get PathSeparator() As String
Attribute PathSeparator.VB_Description = "Gets the path separator used by the
 FullPath property of a Node."
   PathSeparator = m_sPathSeparator
End Property
Public Property Let PathSeparator(ByVal Value As String)
   If Not (StrComp(Value, m_sPathSeparator) = 0) Then
      m_sPathSeparator = Value
      PropertyChanged "PathSeparator"
   End If
End Property

Public Property Get Scroll() As Boolean
Attribute Scroll.VB_Description = "Raised when the control is scrolled."
   Scroll = m_bScroll
End Property
Public Property Let Scroll(ByVal Value As Boolean)
   If Not (m_bScroll = Value) Then
      m_bScroll = Value
      pSetStyles
      PropertyChanged "Scroll"
   End If
End Property

Public Property Get SelectedItem() As cCTreeViewNode
Attribute SelectedItem.VB_Description = "Gets the selected node, if any,
 otherwise returns Nothing."
   Dim lID As Long
   lID = fSelected()
   If Not (lID = 0) Then
      Dim cNod As New cCTreeViewNode
      cNod.fInit Me, lID
      Set SelectedItem = cNod
   End If
End Property

Public Property Get SingleSel() As Boolean
Attribute SingleSel.VB_Description = "Gets/sets whether the only expanded nodes
 should be the ones containing the selection."
   SingleSel = m_bSingleSel
End Property
Public Property Let SingleSel(ByVal Value As Boolean)
   If Not (m_bSingleSel = Value) Then
      m_bSingleSel = Value
      pSetStyles
      PropertyChanged "SingleSel"
   End If
End Property

Public Property Get Sorted() As Boolean
Attribute Sorted.VB_Description = "Not used.  See ChildSortMode and Sort in
 cTreeViewNode."
   '
   ' NOT USED: use child sort mode instead...
   '
End Property
Public Property Let Sorted(ByVal Value As Boolean)
   '
   ' NOT USED: use child sort mode instead...
   '
End Property

Public Property Let StateImageList(Value As Variant)
Attribute StateImageList.VB_Description = "Associates an image list with the
 control used to draw State Images."
Dim hIml As Long
   '
    If (VarType(Value) = vbLong) Then
      ' Assume a handle to an image list:
      hIml = Value
   ElseIf (VarType(hIml) = vbObject) Then
      ' Assume a VB image list:
      On Error Resume Next
      ' Get the image list initialised..
      Value.ListImages(1).Draw 0, 0, 0, 1
      hIml = Value.hImagelist
      If (Err.Number = 0) Then
          ' OK
      Else
          gErr 4, "vbalColumnTreeViewCtl"
      End If
      On Error GoTo 0
   End If
   
   If Not (hIml = 0) Then
      SendMessageL m_hWnd, TVM_SETIMAGELIST, TVSIL_STATE, hIml
   End If
   '
End Property

Public Property Get Style() As ETreeViewStyleConstants
Attribute Style.VB_Description = "Gets/sets the style of the TreeView."
   Style = m_eTreeViewStyle
End Property
Public Property Let Style(ByVal Value As ETreeViewStyleConstants)
   If (Not (m_eTreeViewStyle = Value)) Then
      m_eTreeViewStyle = Value
      pSetStyles
      PropertyChanged "Style"
   End If
End Property

Public Property Get Tag() As String
Attribute Tag.VB_Description = "Gets/sets a string tag associated with the
 control."
   Tag = m_sTag
End Property
Public Property Let Tag(ByVal Value As String)
   If Not (StrComp(m_sTag, Value) = 0) Then
      Tag = m_sTag
      PropertyChanged "Tag"
   End If
End Property

Public Property Get TooltipBackColor() As OLE_COLOR
Attribute TooltipBackColor.VB_Description = "Gets/sets the background colour of
 tooltips displayed by the control."
   TooltipBackColor = m_oTooltipBackColor
End Property
Public Property Let TooltipBackColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oTooltipBackColor) Then
      m_oTooltipBackColor = Value
      If Not (m_hWnd = 0) Then
         Dim hWndTT As Long
         hWndTT = SendMessage(m_hWnd, TVM_GETTOOLTIPS, 0, 0)
         SendMessageL hWndTT, TTM_SETTIPBKCOLOR, TranslateColor(Value), 0
      End If
      PropertyChanged "TooltipBackColor"
   End If
End Property

Public Property Get TooltipForeColor() As OLE_COLOR
Attribute TooltipForeColor.VB_Description = "Gets/sets the foreground colour of
 tooltips displayed by the control."
   TooltipForeColor = m_oTooltipForeColor
End Property
Public Property Let TooltipForeColor(ByVal Value As OLE_COLOR)
   If Not (Value = m_oTooltipForeColor) Then
      m_oTooltipForeColor = Value
      If Not (m_hWnd = 0) Then
         Dim hWndTT As Long
         hWndTT = SendMessage(m_hWnd, TVM_GETTOOLTIPS, 0, 0)
         SendMessageL hWndTT, TTM_SETTIPTEXTCOLOR, TranslateColor(Value), 0
      End If
      PropertyChanged "TooltipBackColor"
   End If
End Property

Public Sub Refresh()
Attribute Refresh.VB_Description = "Refreshes the control."
   If Not (m_hWnd = 0) Then
      Dim rc As RECT
      GetClientRect m_hWnd, rc
      InvalidateRect m_hWnd, rc, 1
      UpdateWindow m_hWnd
   End If
End Sub

Friend Function TranslateAccelerator(lpMsg As VBOleGuids.MSG) As Long
    TranslateAccelerator = S_FALSE
    If m_hWnd <> 0 Then
        ' Here you can modify the response to the key down
        ' accelerator command using the values in lpMsg.  This
        ' can be used to capture Tabs, Returns, Arrows etc.
        ' Just process the message as required and return S_OK.
        If lpMsg.message = WM_KEYDOWN Or lpMsg.message = WM_KEYUP Then
            Select Case lpMsg.wParam And &HFFFF&
            Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyPageDown,
             vbKeyPageUp, vbKeyHome, vbKeyEnd, vbKeyReturn
                SendMessageL m_hWnd, lpMsg.message, lpMsg.wParam, lpMsg.lParam
                TranslateAccelerator = S_OK
            End Select
        End If
    End If
End Function

Friend Function fAddColumn( _
      ByVal Key As String, _
      ByVal sText As String, _
      ByVal lIcon As Long, _
      ByVal lWidth As Long _
   ) As cCTreeViewColumn
Dim lIndex As Long
Dim lID As Long
   
   For lIndex = 0 To m_cHeader.ColumnCount - 1
      If (m_cHeader.ColumnKey(lIndex) = Key) Then
         gErr 5, "vbalColumnTreeView"
         Exit Function
      End If
   Next lIndex

   lID = NextId
   lIndex = m_cHeader.AddColumn(sText, lWidth, , lID, lIcon)
   If (lIndex > -1) Then
      m_cHeader.ColumnKey(lIndex) = Key
      Refresh
      UserControl_Resize
      Dim cCol As New cCTreeViewColumn
      cCol.fInit Me, lID
      Set fAddColumn = cCol
   Else
      gErr 7, "vbalColumnTreeView"
   End If
   
End Function
Friend Function fColumnForIndex(index As Variant) As Long
Dim lIndex As Long
Dim lCol As Long
   If IsNumeric(lIndex) Then
      If (index >= 1) And (index <= m_cHeader.ColumnCount) Then
         fColumnForIndex = index
      End If
   Else
      For lIndex = 1 To m_cHeader.ColumnCount
         If (m_cHeader.ColumnKey(lIndex - 1) = index) Then
            fColumnForIndex = lIndex
            Exit Function
         End If
      Next lIndex
   End If
End Function
Friend Function fColumnForID(ByVal lID As Long) As Long
Dim lIndex As Long
   For lIndex = 1 To m_cHeader.ColumnCount
      If m_cHeader.ColumnExtraData(lIndex - 1) = lID Then
         fColumnForID = lIndex
         Exit For
      End If
   Next lIndex
End Function
Friend Sub fRemoveColumn(index As Variant)
Dim lIndex As Long
   lIndex = fColumnForIndex(index)
   If (lIndex > 0) Then
      If (lIndex = 1) Then
         gErr 8, "vbalColumnTreeView"
      Else
         m_cHeader.RemoveColumn lIndex - 1
         Refresh
         UserControl_Resize
      End If
   Else
      gErr 6, "vbalColumnTreeView"
   End If
End Sub
Friend Function fColumnCount() As Long
   fColumnCount = m_cHeader.ColumnCount
End Function
Friend Property Get fColumn(index As Variant) As cCTreeViewColumn
Dim lIndex As Long
   lIndex = fColumnForIndex(index)
   If (lIndex > 0) Then
      Dim cCol As New cCTreeViewColumn
      cCol.fInit Me, m_cHeader.ColumnExtraData(lIndex - 1)
      Set fColumn = cCol
   Else
      gErr 6, "vbalColumnTreeView"
   End If
End Property
Friend Property Get fColumnKey(ByVal lColumn As Long) As String
   fColumnKey = m_cHeader.ColumnKey(lColumn - 1)
End Property
Friend Property Get fColumnTag(ByVal lColumn As Long) As String
   fColumnTag = m_cHeader.ColumnTag(lColumn - 1)
End Property
Friend Property Let fColumnTag(ByVal lColumn As Long, ByVal sTag As String)
   m_cHeader.ColumnTag(lColumn - 1) = sTag
End Property
Friend Property Get fColumnText(ByVal lColumn As Long) As String
   fColumnText = m_cHeader.ColumnHeader(lColumn - 1)
End Property
Friend Property Let fColumnText(ByVal lColumn As Long, ByVal sText As String)
   m_cHeader.ColumnHeader(lColumn - 1) = sText
End Property
Friend Property Get fColumnImage(ByVal lColumn As Long) As Long
   fColumnImage = m_cHeader.ColumnImage(lColumn - 1)
End Property
Friend Property Let fColumnImage(ByVal lColumn As Long, ByVal lImage As Long)
   m_cHeader.ColumnImage(lColumn - 1) = lImage
End Property
Friend Property Get fColumnWidth(ByVal lColumn As Long) As Long
   fColumnWidth = m_cHeader.ColumnWidth(lColumn - 1)
End Property
Friend Property Let fColumnWidth(ByVal lColumn As Long, ByVal lWidth As Long)
   m_cHeader.ColumnWidth(lColumn - 1) = lWidth
End Property

Friend Sub fRemove(ByVal lID As Long)
Dim hItem As Long
   hItem = m_colIDs.Item(CStr(lID))
   SendMessageL m_hWnd, TVM_DELETEITEM, 0, hItem
   ' The notification back to the control will
   ' actually clear everything up during the delete
End Sub

Friend Sub fRemoveChildren(ByVal lID As Long)
Dim hItem As Long
Dim hItemChild As Long
   hItem = m_colIDs.Item(CStr(lID))
   hItemChild = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_CHILD, hItem)
   Do While Not (hItemChild = 0)
      SendMessageL m_hWnd, TVM_DELETEITEM, 0, hItemChild
      hItemChild = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_CHILD, hItem)
   Loop
End Sub

Friend Sub fRemoveAll()
   ' Say -1 for the root to clear it all.
   ShowWindow m_hWnd, SW_HIDE
   SendMessageL m_hWnd, TVM_DELETEITEM, 0, TVI_ROOT
   Set m_colData = New Collection
   Set m_colKeys = New Collection
   Set m_colIndexes = New Collection
   Set m_colIDs = New Collection
   ShowWindow m_hWnd, SW_SHOW
End Sub

Public Property Get NodeCount() As Long
Attribute NodeCount.VB_Description = "Gets the number of nodes in the Tree."
Dim lCount As Long
   lCount = SendMessageL(m_hWnd, TVM_GETCOUNT, 0, 0)
   If (lCount < 0) Then
      lCount = &HFFFF& + lCount ' KB Q182231
   End If
   NodeCount = lCount
End Property

Friend Property Get fCount(ByVal lID As Long)
Dim iCount As Long
Dim hItem As Long
Dim lErr As Long
Dim rel As Long
   
   On Error Resume Next
   hItem = m_colIDs(CStr(lID))
   lErr = Err.Number
   On Error GoTo 0
   If (lErr = 0) Then
      rel = TVGN_CHILD
      Do While Not (hItem = 0)
         hItem = SendMessageL(m_hWnd, TVM_GETNEXTITEM, rel, hItem)
         If Not (hItem = 0) Then
            iCount = iCount + 1
         End If
         rel = TVGN_NEXT
      Loop
      fCount = iCount
   End If
   
End Property

Friend Function fIDForIndex(index As Variant) As Long
Dim lID As Long
Dim cCast As cCTreeViewNode
Dim hItem As Long

   If TypeOf index Is cCTreeViewNode Then
      Set cCast = index
      lID = cCast.ID
   ElseIf (IsNumeric(index)) Then
      ' This returns the node by
      ' the order added.  Otherwise, you
      ' need to enumerate the nodes and
      ' that is slow (not that this isn't
      ' slow already)
      hItem = m_colIndexes(index)
      If Not (hItem = 0) Then
         lID = fIDForhItem(hItem)
      End If
   Else
      ' a key
      hItem = m_colIndexes(CStr(index))
      If Not (hItem = 0) Then
         lID = fIDForhItem(hItem)
      End If
   End If
   fIDForIndex = lID
End Function
Friend Function fNumericIndexInSubTree(ByVal lID As Long) As Long
Dim hItem As Long
Dim hItemParent As Long
Dim hItemTest As Long
Dim lErr As Long
Dim rel As Long
Dim lCount As Long

   
   On Error Resume Next
   hItem = m_colIDs(CStr(lID))
   lErr = Err.Number
   On Error GoTo 0
   If (lErr = 0) Then
      hItemParent = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PARENT, hItem)
   
      hItemTest = hItemParent
      rel = TVGN_CHILD
      Do
         hItemTest = SendMessageL(m_hWnd, TVM_GETNEXTITEM, rel, hItemTest)
         lCount = lCount + 1
         If (hItemTest = hItem) Then
            fNumericIndexInSubTree = lCount
            Exit Do
         Else
            rel = TVGN_NEXT
         End If
      Loop While Not hItemTest = 0
   End If

End Function
Friend Function fIDForNumericIndexInSubTree(ByVal lIDParent As Long, ByVal
 iIndex As Long) As Long
Dim hItem As Long
Dim hItemParent As Long
Dim iCount As Long
Dim lErr As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim rel As Long

   On Error Resume Next
   hItemParent = m_colIDs(CStr(lIDParent))
   lErr = Err.Number
   On Error GoTo 0
   If (lErr = 0) Then
      hItem = hItemParent
      rel = TVGN_CHILD
      Do While (iCount <= iIndex) And Not (hItem = 0)
         hItem = SendMessageL(m_hWnd, TVM_GETNEXTITEM, rel, hItem)
         If Not (hItem = 0) Then
            iCount = iCount + 1
         End If
         If (iCount = iIndex) Then
            If Not (hItem = 0) Then
                If pbGetItemInfo(hItem, tIS, lPtr) Then
                  fIDForNumericIndexInSubTree = tIS.lID
                  Exit Do
               End If
            End If
         End If
         rel = TVGN_NEXT
      Loop
   End If
   
End Function

Friend Function fhItemForID(ByVal lID As Long) As Long
Dim hItem As Long
   On Error Resume Next
   hItem = m_colIDs.Item(CStr(lID))
   If (Not (Err.Number = 0)) Then
      hItem = 0
   End If
   On Error GoTo 0
   fhItemForID = hItem
End Function

Friend Function fIDForhItem(ByVal hItem As Long) As Long
    Dim tIS As tTreeViewInfoStore
    Dim lPtr As Long
    If pbGetItemInfo(hItem, tIS, lPtr) Then
        fIDForhItem = tIS.lID
    End If
End Function

Friend Function fParentContainsItem(ByVal lParentID As Long, ByVal lID As Long)
 As Boolean

End Function

Friend Function fMoveNode( _
      ByVal lID As Long, _
      nodeRelative As cCTreeViewNode, _
      ByVal relation As ETreeViewRelationshipContants _
   ) As Long
   
   ' Procedure is as follows:
   
   ' Recursively create duplicates of the node
   ' until there are none left, then delete the
   ' original, with the keys adjusted using a
   ' random string.  Once complete, fix up
   ' the keys by removing the random string
Dim sRandomString  As String
Dim lIDRelative As Long
   
   sRandomString = "TVMN" & timeGetTime() & ":"
   lIDRelative = nodeRelative.fID
   fMoveNode = recurseDuplicateAndMoveNode(lID, lIDRelative, relation,
    sRandomString)
   
   
End Function

Private Function recurseDuplicateAndMoveNode( _
      ByVal lID As Long, _
      ByVal lIDRelative As Long, _
      ByVal relation As ETreeViewRelationshipContants, _
      ByVal sKeyTemp As String _
   ) As Long
Dim lIDNew As Long
Dim lPtr As Long
Dim lPtrTo As Long
Dim hItemFrom As Long
Dim hItemTo As Long
Dim sKey As String
Dim tIS As tTreeViewInfoStore
Dim tISJunk As tTreeViewInfoStore
Dim lIDChild As Long
   
   sKey = sKeyTemp & fItemKey(lID)
   hItemFrom = fhItemForID(lID)
   ' Do the node itself:
   lIDNew = fAdd(lIDRelative, relation, sKey, fItemText(lID), fItemImage(lID),
    fItemSelectedImage(lID), , fItemBold(lID), fChildSortMode(lID))
   hItemTo = fhItemForID(lIDNew)
   

   
   ' Now do any children
   lIDChild = fItemChild(lID)
   Do While (lIDChild > 0)
      recurseDuplicateAndMoveNode lIDChild, lIDNew, etvwChild, sKeyTemp
      lIDChild = fItemChild(lID)
   Loop
   
   ' Remove the original node
   fRemove lID
   fItemKey(lIDNew) = Mid(sKey, Len(sKeyTemp) + 1)
   
   ' Return the new node
   recurseDuplicateAndMoveNode = lIDNew
   
End Function

Friend Function fAdd( _
      ByVal lIDRelative As Long, _
      ByVal relation As ETreeViewRelationshipContants, _
      ByVal sKey As String, _
      ByVal sText As String, _
      Optional Image As Long = -1, _
      Optional SelectedImage As Long = -1, _
      Optional integralHeight As Long = 1, _
      Optional Bold As Boolean = False, _
      Optional ChildSortMode As ETreeViewChildrenSortMode = etvwNoSort _
   ) As Long
Dim TVIN As TVINSERTSTRUCT
Dim hRelative As Long
Dim hNew As Long
Dim hItemPrev As Long
Dim TVI As TVITEMEX
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim lID As Long
Dim lErr As Long
Dim sKeyAlready As String
Dim lIDParent As Long
Dim eParentSortMode As ETreeViewChildrenSortMode

   ' Check validity of key
   On Error Resume Next
   sKeyAlready = m_colIndexes(sKey)
   lErr = Err.Number
   On Error GoTo 0
   If (lErr = 0) Then
      gErr 5, "vbalColumnTreeView"
      Exit Function
   End If

   lID = NextId
    
   ' By default, assume the new item will be a child of
   ' the relative item.
   If Not (lIDRelative = 0) Then
      hRelative = m_colIDs(CStr(lIDRelative))
   End If
   
   TVIN.hParent = hRelative
   ' Set the mask to whatever's been specified.
   If Image >= 0 Then
       TVIN.Item.mask = TVIN.Item.mask Or TVIF_IMAGE
       If SelectedImage < 0 Then
           SelectedImage = Image
           TVIN.Item.mask = TVIN.Item.mask Or TVIF_SELECTEDIMAGE
       End If
   End If
   If SelectedImage >= 0 Then
       TVIN.Item.mask = TVIN.Item.mask Or TVIF_SELECTEDIMAGE
   End If
   If integralHeight Then
       TVIN.Item.mask = TVIN.Item.mask Or TVIF_INTEGRAL
   End If
   TVIN.Item.mask = TVIN.Item.mask Or TVIF_STATE Or TVIF_TEXT Or TVIF_PARAM
   ' Initialize the text buffer and buffer-length.
   TVIN.Item.pszText = sText & vbNullChar
   TVIN.Item.cchTextMax = Len(sText) + 1
   ' Set the other properties. If we didn't specify them,
   ' it's okay because we only set the mask to what we
   ' want. Gotta love that mask member.
   If Image >= 0 Then
       TVIN.Item.iImage = Image
   End If
   If SelectedImage >= 0 Then
       TVIN.Item.iSelectedImage = SelectedImage
   End If
   TVIN.Item.iIntegral = integralHeight
   TVIN.Item.stateMask = TVIS_BOLD
   TVIN.Item.State = IIf(Bold, TVIS_BOLD, 0)
   
   If (relation = etvwFirst) Then
       ' Or to insert it first under hRel.
       TVIN.hInsertAfter = TVI_FIRST
   ElseIf (relation = etvwLast) Then
       ' Or even last, if you want.
       TVIN.hInsertAfter = TVI_LAST
   ElseIf (relation = etvwNext) Then
       ' If it's Next, then set the parent to the
       ' relative item's parent ...
       TVIN.hParent = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PARENT,
        hRelative)
       ' ... so we're brothers with it. Aw.
       TVIN.hInsertAfter = hRelative
   ElseIf (relation = etvwPrevious) Then
      ' Find the previous item
      hItemPrev = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PREVIOUS,
       hRelative)
      If (hItemPrev = 0) Then
         ' Same as first
         TVIN.hParent = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PARENT,
          hRelative)
         TVIN.hInsertAfter = TVI_FIRST
      Else
         ' next with previous item as relative
         TVIN.hParent = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PARENT,
          hRelative)
         TVIN.hInsertAfter = hItemPrev
      End If
   End If
   TVIN.Item.lParam = lID
   
   ' Add that sucker to our control.
   hNew = SendMessage(m_hWnd, TVM_INSERTITEM, 0, TVIN)
   
   If Not (hNew = 0) Then
      
      ' Allow the hItem to be looked up by ID
      m_colIDs.Add hNew, CStr(lID)
      ' Add the handle to our collection, so it can
      ' be referenced by key.
       m_colIndexes.Add hNew, sKey
      ' And vice versa.
      m_colKeys.Add sKey, CStr(hNew)
      
      ' Add the default members to the collections.
      lPtr = isMalloc.Alloc(LenB(tIS))
      tIS.hRel = hNew
      tIS.bDoBackColor = False
      tIS.bDoColor = False
      tIS.eSortMode = ChildSortMode
      tIS.bDoFont = False
      tIS.ItemBackColor = m_oBackColor
      tIS.ItemColor = m_oForeColor
      tIS.ItemFont = 0 ' the default
      tIS.lID = lID
      CopyMemory ByVal lPtr, tIS, LenB(tIS)
      m_colData.Add lPtr, CStr(hNew)
      
      ' If we've told the parent to sort, then sort.
      lIDParent = fIDForhItem(TVIN.hParent)
      If Not (lIDParent = 0) Then
         eParentSortMode = fChildSortMode(lIDParent)
         fSortChildren lIDParent, eParentSortMode
      End If
    
      ' Return the id
      fAdd = lID

   End If
    
End Function

' The item that's under a dragged item.
Friend Property Get fDropTarget() As Long
    fDropTarget = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_DROPHILITE, 0)
End Property

Friend Property Let fDropTarget(ByVal hItem As Long)
    SendMessageL m_hWnd, TVM_SELECTITEM, TVGN_DROPHILITE, hItem
End Property

Friend Property Get fItemSubItem(ByVal lID As Long, ByVal lIndex As Long) As
 cCTreeViewNodeSubItem
   If (lIndex > 0) And (lIndex <= m_cHeader.ColumnCount) Then
      Dim cS As New cCTreeViewNodeSubItem
      cS.fInit Me, lID, lIndex
      Set fItemSubItem = cS
   Else
      gErr 6, "vbalColumnTreeView"
   End If
End Property
Friend Property Get fSubItemText(ByVal lID As Long, ByVal lIndex As Long) As
 String
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim cSI As cSubItems
Dim lPtr As Long
   '
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Not (tIS.lPtrSubItems = 0) Then
         Set cSI = ObjectFromPtr(tIS.lPtrSubItems)
         fSubItemText = cSI.Item(lIndex)
      Else
         fSubItemText = ""
      End If
   End If
   '
End Property
Private Function getSubItems(ByVal lID As Long, ByVal lIndex As Long) As
 cSubItems
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim cSI As cSubItems

   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If (tIS.lPtrSubItems = 0) Then
         ' Create sub items
         Set cSI = New cSubItems
         
         ' Add a reference to it (released during
         ' item deletion)
         Dim iUnk As IShellFolderEx_TLB.IUnknown
         Set iUnk = cSI
         iUnk.AddRef
         
         ' Store it
         tIS.lPtrSubItems = ObjPtr(cSI)
         pbPutItemInfo tIS, lPtr
         
      Else
         Set cSI = ObjectFromPtr(tIS.lPtrSubItems)
      End If
      
      Set getSubItems = cSI
   End If
End Function

Friend Property Let fSubItemText(ByVal lID As Long, ByVal lIndex As Long, ByVal
 sText As String)
Dim cSI As cSubItems
   '
   Set cSI = getSubItems(lID, lIndex)
   If Not (cSI Is Nothing) Then
      cSI.Item(lIndex) = sText
   End If
   '
End Property
Friend Property Get fSubItemImage(ByVal lID As Long, ByVal lIndex As Long) As
 Long
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim cSI As cSubItems
Dim lPtr As Long
   '
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Not (tIS.lPtrSubItems = 0) Then
         Set cSI = ObjectFromPtr(tIS.lPtrSubItems)
         fSubItemImage = cSI.Image(lIndex)
      Else
         fSubItemImage = ""
      End If
   End If
   '
End Property
Friend Property Let fSubItemImage(ByVal lID As Long, ByVal lIndex As Long,
 ByVal lImage As Long)
Dim cSI As cSubItems
   '
   Set cSI = getSubItems(lID, lIndex)
   If Not (cSI Is Nothing) Then
      cSI.Image(lIndex) = lImage
   End If
   '
End Property

Friend Property Get fItemBackColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemBackColor = m_oBackColor
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoBackColor Then
         fItemBackColor = tIS.ItemBackColor
      End If
   End If
   
End Property

Friend Property Let fItemBackColor(ByVal lID As Long, ByVal Value As OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = m_oBackColor Then
         tIS.bDoBackColor = False
      Else
         tIS.bDoBackColor = True
      End If
      tIS.ItemBackColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property

Friend Property Get fItemSelectedBackColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemSelectedBackColor = vbHighlight
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoSelectedBackColor Then
         fItemSelectedBackColor = tIS.ItemSelectedBackColor
      End If
   End If
   
End Property

Friend Property Let fItemSelectedBackColor(ByVal lID As Long, ByVal Value As
 OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = vbHighlight Or Value = -1 Then
         tIS.bDoSelectedBackColor = False
      Else
         tIS.bDoSelectedBackColor = True
      End If
      tIS.ItemSelectedBackColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property

Friend Property Get fItemMouseOverBackColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemMouseOverBackColor = -1
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoMouseOverBackColor Then
         fItemMouseOverBackColor = tIS.ItemMouseOverBackColor
      End If
   End If
   
End Property

Friend Property Let fItemMouseOverBackColor(ByVal lID As Long, ByVal Value As
 OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = -1 Or Value = vbWindowBackground Then
         tIS.bDoMouseOverBackColor = False
      Else
         tIS.bDoMouseOverBackColor = True
      End If
      tIS.ItemMouseOverBackColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property

Friend Property Get fItemSelectedMouseOverBackColor(ByVal lID As Long) As
 OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemSelectedMouseOverBackColor = -1
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoSelectedMouseOverBackColor Then
         fItemSelectedMouseOverBackColor = tIS.ItemSelectedMouseOverBackColor
      End If
   End If
   
End Property

Friend Property Let fItemSelectedMouseOverBackColor(ByVal lID As Long, ByVal
 Value As OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = -1 Or Value = vbHighlight Then
         tIS.bDoSelectedMouseOverBackColor = False
      Else
         tIS.bDoSelectedMouseOverBackColor = True
      End If
      tIS.ItemSelectedMouseOverBackColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property

Friend Property Get fItemSelectedNoFocusBackColor(ByVal lID As Long) As
 OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemSelectedNoFocusBackColor = -1
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoSelectedNoFocusBackColor Then
         fItemSelectedNoFocusBackColor = tIS.ItemSelectedNoFocusBackColor
      End If
   End If
   
End Property

Friend Property Let fItemSelectedNoFocusBackColor(ByVal lID As Long, ByVal
 Value As OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = -1 Or Value = vbButtonFace Then
         tIS.bDoSelectedNoFocusBackColor = False
      Else
         tIS.bDoSelectedNoFocusBackColor = True
      End If
      tIS.ItemSelectedNoFocusBackColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property


Friend Property Get fItemBold(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemBold = pbIsState(hItem, TVIS_BOLD)
End Property

Friend Property Let fItemBold(ByVal lID As Long, ByVal Value As Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pSetState hItem, TVIS_BOLD, Value
End Property



Friend Property Get fItemChecked(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   m_itemStyle.stateMask = TVIS_STATEIMAGEMASK
   pGetStyle hItem, TVIF_STATE
   ' The state image is stored 12 bits above the rest,
   ' (2 ^ 12 = &H1000), so divide the rest out. Add one,
   ' because state images are one-based (zero means no
   ' image).
   fItemChecked = CBool((m_itemStyle.State \ &H1000) - 1)
End Property

Friend Property Let fItemChecked(ByVal lID As Long, ByVal Value As Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   m_itemStyle.stateMask = TVIS_STATEIMAGEMASK
   pGetStyle hItem, TVIF_STATE
   m_itemStyle.stateMask = TVIS_STATEIMAGEMASK
   ' Get that one-based state image 12 bits up,
   ' (2 ^ 12 = &H1000).
   m_itemStyle.State = (IIf(Value, 2, 1) * &H1000)
   pSetIStyle hItem, TVIF_STATE
End Property

Friend Property Get fItemNoCheckBox(ByVal lID As Long) As Boolean
Dim hItem As Long
Dim iCheckState As Long
   hItem = m_colIDs(CStr(lID))
   m_itemStyle.stateMask = TVIS_STATEIMAGEMASK
   pGetStyle hItem, TVIF_STATE
   ' The state image is stored 12 bits above the rest,
   ' (2 ^ 12 = &H1000), so divide the rest out. Add one,
   ' because state images are one-based (zero means no
   ' image).
   iCheckState = m_itemStyle.State \ &H1000
   fItemNoCheckBox = (iCheckState = 0)
End Property

Friend Property Let fItemNoCheckBox(ByVal lID As Long, ByVal Value As Boolean)
Dim hItem As Long
Dim iCheckState As Long
   hItem = m_colIDs(CStr(lID))
   m_itemStyle.stateMask = TVIS_STATEIMAGEMASK
   pGetStyle hItem, TVIF_STATE
   m_itemStyle.stateMask = TVIS_STATEIMAGEMASK
   ' Get that one-based state image 12 bits up,
   ' (2 ^ 12 = &H1000).
   iCheckState = m_itemStyle.State \ &H1000
   If (Value) Then
      If (iCheckState <> 0) Then
         m_itemStyle.State = 0
         pSetIStyle hItem, TVIF_STATE
      End If
   Else
      If (iCheckState = 0) Then
         m_itemStyle.State = &H1000
         pSetIStyle hItem, TVIF_STATE
      End If
   End If
End Property


Friend Property Get fItemForeColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long

   fItemForeColor = m_oForeColor
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoColor Then
         fItemForeColor = tIS.ItemColor
      End If
   End If
   
End Property

Friend Property Let fItemForeColor(ByVal lID As Long, ByVal Value As OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
   
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = m_oForeColor Or Value = -1 Then
         tIS.bDoColor = False
      Else
         tIS.bDoColor = True
      End If
      tIS.ItemColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property

Friend Property Get fItemMouseOverColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
   
   fItemMouseOverColor = vbHighlight
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoMouseOverColor Then
         fItemMouseOverColor = tIS.ItemMouseOverColor
      End If
    End If
    
End Property

Friend Property Let fItemMouseOverColor(ByVal lID As Long, ByVal Value As
 OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
    hItem = m_colIDs(CStr(lID))
    If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = vbHighlight Or Value = -1 Or Value = &H800000 Then
         tIS.bDoMouseOverColor = False
      Else
         tIS.bDoMouseOverColor = True
      End If
      tIS.ItemMouseOverColor = Value
      pbPutItemInfo tIS, lPtr
    End If
    
End Property

Friend Property Get fItemSelectedColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
   
   fItemSelectedColor = vbHighlight
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoSelectedColor Then
         fItemSelectedColor = tIS.ItemSelectedColor
      End If
    End If
    
End Property

Friend Property Let fItemSelectedColor(ByVal lID As Long, ByVal Value As
 OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
    hItem = m_colIDs(CStr(lID))
    If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = vbHighlightText Or Value = -1 Then
         tIS.bDoSelectedColor = False
      Else
         tIS.bDoSelectedColor = True
      End If
      tIS.ItemSelectedColor = Value
      pbPutItemInfo tIS, lPtr
    End If
    
End Property


Friend Property Get fItemSelectedMouseOverColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemSelectedMouseOverColor = -1
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoSelectedMouseOverColor Then
         fItemSelectedMouseOverColor = tIS.ItemSelectedMouseOverColor
      End If
   End If
   
End Property

Friend Property Let fItemSelectedMouseOverColor(ByVal lID As Long, ByVal Value
 As OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = -1 Or Value = vbHighlightText Then
         tIS.bDoSelectedMouseOverColor = False
      Else
         tIS.bDoSelectedMouseOverColor = True
      End If
      tIS.ItemSelectedMouseOverColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property

Friend Property Get fItemSelectedNoFocusColor(ByVal lID As Long) As OLE_COLOR
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
    
   fItemSelectedNoFocusColor = -1
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoSelectedNoFocusColor Then
         fItemSelectedNoFocusColor = tIS.ItemSelectedNoFocusColor
      End If
   End If
   
End Property

Friend Property Let fItemSelectedNoFocusColor(ByVal lID As Long, ByVal Value As
 OLE_COLOR)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If Value = -1 Or Value = vbWindowText Then
         tIS.bDoSelectedNoFocusColor = False
      Else
         tIS.bDoSelectedNoFocusColor = True
      End If
      tIS.ItemSelectedNoFocusColor = Value
      pbPutItemInfo tIS, lPtr
   End If
   
End Property
Friend Sub fItemRect(ByVal lID As Long, ByRef lLeft As Long, ByRef lTop As
 Long, ByRef lRight As Long, ByRef lBottom As Long)
Dim lR As Long
Dim tR As RECT
   tR.left = m_colIDs(CStr(lID))
   lR = SendMessage(m_hWnd, TVM_GETITEMRECT, 0, tR)
   lLeft = tR.left
   lTop = tR.top
   lRight = tR.right
   lBottom = tR.bottom
End Sub

Friend Property Get fItemCut(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemCut = pbIsState(hItem, TVIS_CUT)
End Property

Friend Property Let fItemCut(ByVal lID As Long, ByVal Value As Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pSetState hItem, TVIS_CUT, Value
End Property

Friend Property Get fItemData(ByVal lID As Long) As Long
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long

   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      fItemData = tIS.ItemData
   End If
   
End Property
Friend Property Let fItemData(ByVal lID As Long, ByVal Value As Long)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      tIS.ItemData = Value
      pbPutItemInfo tIS, lPtr
   End If

End Property

Friend Property Get fItemNumber(ByVal lID As Long) As Long
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long

   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      fItemNumber = tIS.ItemNumber
   End If
   
End Property
Friend Property Let fItemNumber(ByVal lID As Long, ByVal Value As Long)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      tIS.ItemNumber = Value
      pbPutItemInfo tIS, lPtr
   End If

End Property


Friend Property Get fItemDropHighlight(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemDropHighlight = pbIsState(hItem, TVIS_DROPHILITED)
End Property

Friend Property Let fItemDropHighlight(ByVal lID As Long, ByVal Value As
 Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pSetState hItem, TVIS_DROPHILITED, Value
End Property


Friend Property Get fItemExpanded(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemExpanded = pbIsState(hItem, TVIS_EXPANDED)
End Property

' The next sibling of an item.
Friend Property Get fItemNextSibling(ByVal lID As Long) As Long
Dim hItem As Long
Dim hItemNext As Long
   hItem = m_colIDs(CStr(lID))
   hItemNext = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
   If Not hItemNext = 0 Then
      fItemNextSibling = fIDForhItem(hItemNext)
   End If
End Property
' The previous sibling of an item.
Friend Property Get fItemPreviousSibling(ByVal lID As Long) As Long
Dim hItem As Long
Dim hItemPrev As Long
   hItem = m_colIDs(CStr(lID))
   hItemPrev = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PREVIOUS, hItem)
   If Not hItemPrev = 0 Then
      fItemPreviousSibling = fIDForhItem(hItemPrev)
   End If
End Property

' The first child item of an item.
Friend Property Get fItemChild(ByVal lID As Long) As Long
Dim hItem As Long
Dim hItemChild As Long
   hItem = m_colIDs(CStr(lID))
   hItemChild = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_CHILD, hItem)
   If Not (hItemChild = 0) Then
      fItemChild = fIDForhItem(hItemChild)
   End If
End Property

Friend Property Get fItemLastSibling(ByVal lID As Long) As Long
Dim hItem As Long
Dim hItemTest As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
   hItem = m_colIDs(CStr(lID))
   hItemTest = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
   Do While Not (hItemTest = 0)
      hItem = hItemTest
      hItemTest = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
   Loop
   If Not (hItem = 0) Then
      If pbGetItemInfo(hItem, tIS, lPtr) Then
         fItemLastSibling = tIS.lID
      End If
   End If
End Property

' The parent of an item.
Friend Function fItemParent(ByVal lID As Long) As Long
Dim hItem As Long
Dim hItemParent As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
   hItem = m_colIDs(CStr(lID))
   hItemParent = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PARENT, hItem)
   If pbGetItemInfo(hItemParent, tIS, lPtr) Then
      fItemParent = tIS.lID
   End If
End Function


Friend Property Get fItemHasChildren(ByVal lID As Long) As Boolean
'DLL (Fixed!): Aggggg. The following code is just reading the
' ItemPlusMinus property. So if you change that property,
' this is useless.
'    GetStyle Item, TVIF_CHILDREN
'    ' If the cChildren member is 1, then it has children,
'    ' otherwise, it's zero. It's not the *count* of children.
'    ItemHasChildren = CBool(ItemStyle.cChildren)
'Since the above code sucks, we manually find if the
' item's ItemChild property returns zero.
    fItemHasChildren = CBool(fItemChild(lID))
End Property

Friend Property Get fItemImage(ByVal lID As Long) As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_IMAGE
   fItemImage = m_itemStyle.iImage
End Property

Friend Property Let fItemImage(ByVal lID As Long, ByVal Value As Long)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_IMAGE
   m_itemStyle.iImage = Value
   pSetIStyle hItem, TVIF_IMAGE
End Property

Friend Property Get fItemSelectedImage(ByVal lID As Long) As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_SELECTEDIMAGE
   fItemSelectedImage = m_itemStyle.iSelectedImage
End Property

Friend Property Let fItemSelectedImage(ByVal lID As Long, ByVal Value As Long)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_SELECTEDIMAGE
   m_itemStyle.iSelectedImage = Value
   pSetIStyle hItem, TVIF_IMAGE Or TVIF_SELECTEDIMAGE
End Property

Friend Property Get fItemIndex(Key As String) As Long
   fItemIndex = m_colIndexes(Key)
End Property

Friend Property Get fItemIntegralHeight(ByVal lID As Long) As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_INTEGRAL
   fItemIntegralHeight = m_itemStyle.iIntegral
End Property

Friend Property Let fItemIntegralHeight(ByVal lID As Long, ByVal Value As Long)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_INTEGRAL
   m_itemStyle.iIntegral = Value
   pSetIStyle hItem, TVIF_INTEGRAL
End Property


Friend Property Get fItemKey(ByVal lID As Long) As String
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   ' Get the key value out of our collection.
   fItemKey = m_colKeys(CStr(hItem))
End Property

Friend Property Let fItemKey(ByVal lID As Long, ByVal Value As String)
Dim hItem As Long
Dim lErr As Long
Dim sKeyAlready As String
   
   ' Check validity of key
   On Error Resume Next
   sKeyAlready = m_colIndexes(Value)
   lErr = Err.Number
   On Error GoTo 0
   If (lErr = 0) Then
      gErr 5, "vbalColumnTreeView"
      Exit Property
   End If
   
   hItem = m_colIDs(CStr(lID))
   
   m_colIndexes.Remove m_colKeys(CStr(hItem))
    m_colIndexes.Add hItem, Value
   
   m_colKeys.Remove CStr(hItem)
   m_colKeys.Add Value, CStr(hItem)
   
End Property

Friend Property Get fItemPlusMinus(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_CHILDREN
   ' The cChildren member is only 1 or 0, saying whether
   ' it has children or not. But it actually means
   ' whether we should show the PlusMinus or not.
   fItemPlusMinus = CBool(m_itemStyle.cChildren)
End Property

Friend Property Let fItemPlusMinus(ByVal lID As Long, ByVal Value As Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_CHILDREN
   ' cChildren is 1 or 0, saying whether it has children.
   ' If we fake it out, and tell it has children (or
   ' doesn't), we can control whether or not to show
   ' the PlusMinus without adding or deleting items.
   m_itemStyle.cChildren = Abs(CLng(Value))
   pSetIStyle hItem, TVIF_CHILDREN
End Property

Friend Property Get fItemPath(ByVal lID As Long) As String
Dim hItem As Long
Dim sRet As String
   hItem = m_colIDs(CStr(lID))
   Do While Not (hItem = 0)
      pGetStyle hItem, TVIF_TEXT
      If (Len(sRet) > 0) Then
         sRet = m_sPathSeparator & sRet
      End If
      sRet = m_itemStyle.pszText & sRet
      hItem = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_PARENT, hItem)
   Loop
   fItemPath = sRet
End Property

Friend Property Get fItemTag(ByVal lID As Long) As String
Dim sTag As String
   On Error Resume Next
   sTag = m_colTags(CStr(lID))
   fItemTag = sTag
End Property
Friend Property Let fItemTag(ByVal lID As Long, ByVal sTag As String)
   On Error Resume Next
   m_colTags.Remove CStr(lID)
   On Error GoTo 0
   m_colTags.Add sTag, CStr(lID)
End Property

Friend Property Get fItemText(ByVal lID As Long) As String
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_TEXT
   fItemText = m_itemStyle.pszText
End Property

Friend Property Let fItemText(ByVal lID As Long, ByVal Value As String)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pGetStyle hItem, TVIF_TEXT
   pSetIStyle hItem, TVIF_TEXT, Value
End Property

' The Selected item.
Friend Property Get fSelected() As Long
Dim hItem As Long
    hItem = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_CARET, fRootItem)
    fSelected = fIDForhItem(hItem)
End Property

Friend Sub fSelectItem(ByVal lID As Long, ByVal State As Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   If (State) Then
      SendMessageL m_hWnd, TVM_SELECTITEM, TVGN_CARET, hItem
   End If
End Sub

Friend Function fScale(xPixels As Long, yPixels As Long, x As Single, y As
 Single)
   x = ScaleX(xPixels, vbPixels, UserControl.ScaleMode)
   y = ScaleY(yPixels, vbPixels, UserControl.ScaleMode)
End Function
Friend Function fUnScale(x As Single, y As Single, xPixels As Long, yPixels As
 Long)
   xPixels = ScaleX(x, UserControl.ScaleMode, vbPixels)
   yPixels = ScaleY(y, UserControl.ScaleMode, vbPixels)
End Function

' The root item.
Friend Property Get fRootItem() As Long
Dim hItem As Long
   hItem = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_ROOT, 0)
   fRootItem = fIDForhItem(hItem)
End Property

' The first visible item in the control.
Friend Property Get fFirstVisible() As Long
Dim hItem As Long
    hItem = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_FIRSTVISIBLE, 0)
    fFirstVisible = fIDForhItem(hItem)
End Property
Friend Property Let fFirstVisible(ByVal lID As Long)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   SendMessageL m_hWnd, TVM_SELECTITEM, TVGN_FIRSTVISIBLE, hItem
End Property

' The previous *visible* item in a control, not the
' previous *sibling*.
Friend Property Get fItemPreviousVisible(ByVal lID As Long) As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemPreviousVisible = SendMessageL(m_hWnd, TVM_GETNEXTITEM,
    TVGN_PREVIOUSVISIBLE, hItem)
End Property

' The next *visible* item in a control, not the next
' *sibling*.
Friend Property Get fItemNextVisible(ByVal lID As Long) As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemNextVisible = SendMessageL(m_hWnd, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE,
    hItem)
End Property

Friend Property Let fItemExpanded(ByVal lID As Long, ByVal Value As Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   ' It won't work right if you just try to set the Expanded state.
   ' You must do it manually.
   If Value Then
      SendMessageL m_hWnd, TVM_EXPAND, TVE_EXPAND, hItem
   Else
      SendMessageL m_hWnd, TVM_EXPAND, TVE_COLLAPSE, hItem
   End If
End Property

Friend Function fItemEnsureVisible(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   ' Make sure an item is visible.
   SendMessageL m_hWnd, TVM_ENSUREVISIBLE, 0, hItem
End Function

Friend Function fItemVisible(ByVal lID As Long) As Boolean
Dim tR As RECT
Dim lR As Long
   tR.left = m_colIDs(CStr(lID))
   lR = SendMessage(m_hWnd, TVM_GETITEMRECT, 0, tR)
   fItemVisible = Not (lR = 0)
End Function

Friend Sub fItemToggle(ByVal lID As Long)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   ' Expand if collapsed, collapse if Expanded.
   ' They go together like a horse and carriage.
   SendMessageL m_hWnd, TVM_EXPAND, TVE_TOGGLE, hItem
End Sub


Friend Sub fItemEndEdit(ByVal lID As Long, ByVal saveChanges As Boolean)
   ' Automagically *stop* editing an item. And save
   ' the changes if you feel like it.
   SendMessageL m_hWnd, TVM_ENDEDITLABELNOW, Abs(saveChanges), 0
End Sub

Friend Sub fItemStartEdit(ByVal lID As Long)
Dim hItem As Long
   'SetFocusAPI m_hWnd
   hItem = m_colIDs(CStr(lID))
   ' Automagically start editing an item.
   SendMessageL m_hWnd, TVM_EDITLABEL, 0, hItem
End Sub

Friend Property Get fItemExpandedOnce(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemExpandedOnce = pbIsState(hItem, TVIS_EXPANDEDONCE)
End Property

Friend Property Get fItemExpandedPartial(ByVal lID As Long) As Boolean
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   fItemExpandedPartial = pbIsState(hItem, TVIS_EXPANDED Or TVIS_EXPANDPARTIAL)
End Property

Friend Property Let fItemExpandedPartial(ByVal lID As Long, ByVal Value As
 Boolean)
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   pSetState hItem, TVIS_EXPANDPARTIAL, Value
End Property

Friend Property Get fItemFont(ByVal lID As Long) As IFont
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
    
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If tIS.bDoFont Then
         Set fItemFont = m_fntItem(tIS.ItemFont)
      Else
         Set fItemFont = Me.Font
      End If
   End If
End Property

Friend Property Let fItemFont(ByVal lID As Long, ByVal fnt As IFont)
   pSetFont lID, fnt
End Property

Friend Property Set fItemFont(ByVal lID As Long, ByVal fnt As IFont)
   pSetFont lID, fnt
End Property

Private Sub pSetFont(ByVal lID As Long, ByVal fnt As IFont)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
Dim lFontIndex As Long
   
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      If fnt Is Nothing Then
         tIS.bDoFont = False
      ElseIf fnt Is Me.Font Then
         tIS.bDoFont = False
      Else
         lFontIndex = plAddFont(fnt)
         tIS.bDoFont = True
         tIS.ItemFont = lFontIndex
      End If
      pbPutItemInfo tIS, lPtr
   End If
   
End Sub

Private Function plAddFont(iFnt As IFont) As Long
    
   Dim i As Long
   For i = 1 To m_lFontCount
       ' Hmmm
       With m_fntItem(i)
           If .Name = iFnt.Name Then
               If .Bold = iFnt.Bold Then
                   If .Size = iFnt.Size Then
                       If .Italic = iFnt.Italic Then
                           If .Underline = iFnt.Underline Then
                               If .Strikethrough = iFnt.Strikethrough Then
                                   If .Charset = iFnt.Charset Then
                                       plAddFont = i
                                       Exit Function
                                   End If
                               End If
                           End If
                       End If
                   End If
               End If
           End If
       End With
   Next i
   
   m_lFontCount = m_lFontCount + 1
   ReDim Preserve m_fntItem(0 To m_lFontCount) As IFont
   Set m_fntItem(m_lFontCount) = iFnt
   plAddFont = m_lFontCount
   
End Function

Friend Sub fSortChildren(ByVal lID As Long, ByVal eSortMode As
 ETreeViewChildrenSortMode)
   ' more efficient if you know you're adding a whole pile of items
   ' to sort like this
   m_eCurrentSortMode = eSortMode
   If (eSortMode = etvwAlphabetic) Then
      SendMessageL m_hWnd, TVM_SORTCHILDREN, 0, fhItemForID(lID)
   ElseIf (eSortMode > etvwAlphabetic) Then
      Dim TVCB As TVSORTCB
      TVCB.hParent = fhItemForID(lID)
      TVCB.lpfnCompare = plAddressOf(AddressOf tvCustomSortProc)
      TVCB.lParam = lID
      Set m_TreeViewControl = Me
      SendMessage m_hWnd, TVM_SORTCHILDRENCB, 0, TVCB
      Set m_TreeViewControl = Nothing
   End If
   '
End Sub

Friend Property Get fChildSortMode(ByVal lID As Long) As
 ETreeViewChildrenSortMode
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      fChildSortMode = tIS.eSortMode
   End If
End Property

Friend Property Let fChildSortMode(ByVal lID As Long, ByVal eSortMode As
 ETreeViewChildrenSortMode)
Dim hItem As Long
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      tIS.eSortMode = eSortMode
      pbPutItemInfo tIS, lPtr
   End If
End Property

Friend Property Get fDoBackColor(ByVal lID As Long) As Boolean
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      fDoBackColor = tIS.bDoBackColor
   End If
End Property

Friend Property Let fDoBackColor(ByVal lID As Long, ByVal bState As Boolean)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      tIS.bDoBackColor = bState
      pbPutItemInfo tIS, lPtr
   End If
End Property

Friend Property Get fDoForeColor(ByVal lID As Long) As Boolean
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      fDoForeColor = tIS.bDoColor
   End If
End Property

Friend Property Let fDoForeColor(ByVal lID As Long, ByVal bState As Boolean)
Dim tIS As tTreeViewInfoStore
Dim lPtr As Long
Dim hItem As Long
   hItem = m_colIDs(CStr(lID))
   If pbGetItemInfo(hItem, tIS, lPtr) Then
      tIS.bDoColor = bState
      pbPutItemInfo tIS, lPtr
   End If
End Property



Private Sub OnDoubleClick(ByVal hItem As Long)
   If Not (m_bTerminate) Then
      RaiseEvent DblClick
      If Not (hItem = 0) Then
         Dim lID As Long
         On Error Resume Next
         lID = fIDForhItem(hItem)
         If (Err.Number = 0 And Not (lID = 0)) Then
            On Error GoTo 0
            Dim cNod As New cCTreeViewNode
            cNod.fInit Me, lID
            RaiseEvent NodeDblClick(cNod)
            If (m_bLabelEdit) Then
               fItemStartEdit lID
            End If
         End If
      End If
   End If
End Sub

Private Sub OnCheckStateChanged(ByVal hItem As Long)
   
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         RaiseEvent nodeCheck(cNod)
      End If
   End If
   
End Sub

Private Sub OnClick()
   '
   If Not (m_bTerminate) Then
      RaiseEvent Click
   End If
   '
End Sub

Private Sub OnBeginDrag(ByVal hItem As Long)
   
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         m_hDragItem = hItem
         m_hDragOver = hItem
         UserControl.OleDrag
      End If
   End If
   
   
End Sub

Private Sub OnNodeClick(ByVal hItem As Long)
   '
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         RaiseEvent NodeClick(cNod)
      End If
   End If
   '
End Sub

Private Sub OnRightClick(pt As POINTAPI, ByVal hItem As Long)
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         RaiseEvent NodeRightClick(cNod)
      End If
      On Error GoTo 0
   End If
End Sub

Private Sub OnBeforeLabelEdit(ByVal hItem As Long, ByRef cancel As Boolean)
   '
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         RaiseEvent BeforeLabelEdit(cNod, cancel)
      End If
      On Error GoTo 0
   End If
   '
End Sub

Private Sub OnAfterLabelEdit(ByVal hItem As Long, ByRef sText As String, ByRef
 cancel As Boolean)
   '
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         RaiseEvent AfterLabelEdit(cNod, sText, cancel)
      End If
      On Error GoTo 0
   End If
   '
End Sub

Private Sub OnItemExpand(ByVal hItem As Long, ByVal actionCode As Long)
   '
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         If (actionCode = TVE_EXPAND Or actionCode = TVE_EXPANDPARTIAL) Then
            RaiseEvent Expand(cNod)
         Else
            RaiseEvent Collapse(cNod)
         End If
      End If
      On Error GoTo 0
   End If
   '
End Sub

Private Sub OnItemExpanding(ByVal hItem As Long, ByVal actionCode As Long,
 ByRef cancel As Boolean)
   '
   If Not (hItem = 0) And Not (m_bTerminate) Then
      Dim lID As Long
      On Error Resume Next
      lID = fIDForhItem(hItem)
      If (Err.Number = 0 And Not (lID = 0)) Then
         On Error GoTo 0
         Dim cNod As New cCTreeViewNode
         cNod.fInit Me, lID
         If (actionCode = TVE_EXPAND Or actionCode = TVE_EXPANDPARTIAL) Then
            RaiseEvent BeforeExpand(cNod, cancel)
         Else
            RaiseEvent BeforeCollapse(cNod, cancel)
         End If
      End If
      On Error GoTo 0
   End If
   
   '
End Sub

Private Sub OnKeyDown(Key As Integer)
   '
   If Not (m_bTerminate) Then
      Dim Shift As Integer
      Shift = pShiftState()
      RaiseEvent KeyDown(Key, Shift)
   End If
   '
End Sub

Private Sub OnKeyPress(ByVal Key As Long)
   '
   If Not (m_bTerminate) Then
      Dim iKey As Integer
      iKey = Key And &H7FFF
      RaiseEvent KeyPress(iKey)
   End If
   '
End Sub


Private Sub OnSelChanged()
   '
   If Not (m_bTerminate) Then
      RaiseEvent SelectedNodeChanged
   End If
   '
End Sub

Private Sub OnSelChanging()
   '
   ' not used as this point
   '
End Sub

Private Sub OnSingleExpand(ByVal hItem As Long, ByVal actionCode As Long)
   '
   ' not used at this point
   '
End Sub

Private Sub OnMouseDown(ByVal iMsg As Long)
Dim x As Single
Dim y As Single
Dim iShift As Integer
Dim iBtn As Integer
Dim tP As POINTAPI
   
   If Not (m_bTerminate) Then
      iBtn = pButton(iMsg)
      iShift = pShiftState()
      GetCursorPos tP
      ScreenToClient m_hWnd, tP
      fScale tP.x, tP.y, x, y
      RaiseEvent MouseDown(iBtn, iShift, x, y)
   End If
   
End Sub

Private Sub OnMouseMove()
Dim x As Single
Dim y As Single
Dim iShift As Integer
Dim iBtn As Integer
Dim tP As POINTAPI
   
   If Not (m_bTerminate) Then
      iBtn = pButton(WM_MOUSEMOVE)
      iShift = pShiftState()
      GetCursorPos tP
      ScreenToClient m_hWnd, tP
      fScale tP.x, tP.y, x, y
      RaiseEvent MouseMove(iBtn, iShift, x, y)
   End If

End Sub

Private Sub OnMouseUp(ByVal iMsg As Long)
Dim x As Single
Dim y As Single
Dim iShift As Integer
Dim iBtn As Integer
Dim tP As POINTAPI
   
   If Not (m_bTerminate) Then
      iBtn = pButton(iMsg)
      iShift = pShiftState()
      GetCursorPos tP
      ScreenToClient m_hWnd, tP
      fScale tP.x, tP.y, x, y
      RaiseEvent MouseDown(iBtn, iShift, x, y)
   End If
   
End Sub

Friend Function OnCustomSort(ByVal lParam1 As Long, ByVal lParam2 As Long,
 ByVal lParamParent As Long) As Long
Dim iCompare As ETreeViewSortResult
    
    ' Check the sort mode of the parent:
    Select Case m_eCurrentSortMode
    Case etvwTagThenAlphabetic
      Dim sTag1 As String
      Dim sTag2 As String
      On Error Resume Next
      sTag1 = m_colTags(lParam1)
      sTag2 = m_colTags(lParam2)
      On Error GoTo 0
      iCompare = StrComp(sTag1, sTag2)
      If (iCompare = etvwItem1EqualsItem2) Then
         iCompare = StrComp(fItemText(lParam1), fItemText(lParam2),
          vbTextCompare)
      End If
      
    Case etvwItemDataThenAlphabetic
      Dim lItemData1 As Long
      Dim lItemData2 As Long
      lItemData1 = fItemData(lParam1)
      lItemData2 = fItemData(lParam2)
      If (lItemData1 < lItemData2) Then
         iCompare = etvwItem1PreceedsItem2
      ElseIf (lItemData1 = lItemData2) Then
         iCompare = StrComp(fItemText(lParam1), fItemText(lParam2),
          vbTextCompare)
      Else
         iCompare = etvwItem1FollowsItem2
      End If
    
    Case etvwCustomSortEvent
    
      Dim cNode1 As New cCTreeViewNode
      Dim cNode2 As New cCTreeViewNode
      Dim cNodeParent As New cCTreeViewNode
      
      cNode1.fInit Me, lParam1
      cNode2.fInit Me, lParam2
      cNodeParent.fInit Me, lParamParent
          
      RaiseEvent CustomSort(cNode1, cNode2, cNodeParent, iCompare)
      
   End Select
   
   OnCustomSort = iCompare
   
End Function

Private Function pButton(ByVal iMsg As Long) As Integer
   Select Case iMsg
   Case WM_LBUTTONDOWN, WM_LBUTTONUP
      pButton = vbLeftButton
   Case WM_RBUTTONDOWN, WM_RBUTTONUP
      pButton = vbRightButton
   Case WM_MBUTTONDOWN, WM_MBUTTONUP
      pButton = vbMiddleButton
   Case WM_MOUSEMOVE
      Select Case True
      Case GetAsyncKeyState(vbKeyLButton)
         pButton = vbLeftButton
      Case GetAsyncKeyState(vbKeyRButton)
         pButton = vbRightButton
      Case GetAsyncKeyState(vbKeyMButton)
         pButton = vbMiddleButton
      End Select
   End Select
End Function


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


Private Sub pDeleteItem(ByVal hItem As Long)
Dim lPtr As Long
Dim sKey As String
Dim shItem As String
Dim tIS As tTreeViewInfoStore
Dim lID As Long

   shItem = CStr(hItem)
   ' Find this item in Data:
   lPtr = m_colData(shItem)
   If Not (lPtr = 0) Then
      CopyMemory tIS, ByVal lPtr, LenB(tIS)
      lID = tIS.lID
      If Not (tIS.lPtrSubItems = 0) Then
         ' Free up the sub items
         Dim iUnk As IShellFolderEx_TLB.IUnknown
         Set iUnk = ObjectFromPtr(tIS.lPtrSubItems)
         iUnk.Release
      End If
      isMalloc.Free ByVal lPtr
   End If
   m_colData.Remove shItem
   sKey = m_colKeys(shItem)
   m_colIDs.Remove CStr(lID)
   m_colKeys.Remove shItem
   m_colIndexes.Remove sKey
   On Error Resume Next
   m_colTags.Remove CStr(lID)
   
End Sub

Private Function pbGetItemInfo(ByVal hItem As Long, ByRef tIS As
 tTreeViewInfoStore, ByRef lPtr As Long) As Boolean
    On Error Resume Next
    lPtr = m_colData(CStr(hItem))
    If Not lPtr = 0 Then
        CopyMemory tIS, ByVal lPtr, LenB(tIS)
        pbGetItemInfo = True
    End If
End Function

Private Function pbPutItemInfo(ByRef tIS As tTreeViewInfoStore, ByVal lPtr As
 Long) As Boolean
    If Not lPtr = 0 Then
        If isMalloc.DidAlloc(ByVal lPtr) Then
            CopyMemory ByVal lPtr, tIS, LenB(tIS)
            pbPutItemInfo = True
        End If
    End If
End Function

Private Function pbIsState( _
      ByVal hItem, _
      ByVal Value As Long, _
      Optional UseAsMask As Boolean = False _
   ) As Boolean
   If UseAsMask Then
      m_itemStyle.stateMask = Value
   End If
   pGetStyle hItem, TVIF_STATE
   pbIsState = ((m_itemStyle.State And Value) = Value)
End Function

Private Sub pSetState(ByVal hItem As Long, ByVal Value As Long, ByVal BOOL As
 Boolean, Optional ByVal UseAsMask As Boolean = True)
   If UseAsMask Then
      m_itemStyle.stateMask = Value
   End If
   pGetStyle hItem, TVIF_STATE
   If BOOL Then
      m_itemStyle.State = m_itemStyle.State Or _
         Value
   Else
      m_itemStyle.State = m_itemStyle.State _
         And (Not Value)
   End If
   pSetIStyle hItem, TVIF_STATE
End Sub

' Retrieves the item info into ItemStyle module variable.
Private Sub pGetStyle(ByVal hItem As Long, ByVal mask As Long)
Dim s As String, e As Long
   
   s = String(260, Chr$(0))
   m_itemStyle.hItem = hItem
   m_itemStyle.mask = mask Or TVIF_HANDLE
   m_itemStyle.pszText = s
   m_itemStyle.cchTextMax = 260
   SendMessage m_hWnd, TVM_GETITEM, 0, m_itemStyle
   e = InStr(1, m_itemStyle.pszText, Chr$(0))
   m_itemStyle.pszText = left$(m_itemStyle.pszText, e - 1)
   m_itemStyle.cchTextMax = Len(m_itemStyle.pszText)
   
End Sub

' SetIStyle, not to be confused with SetStyle.
' Sets the item info from ItemStyle module variable.
Private Sub pSetIStyle(ByVal hItem As Long, ByVal mask As Long, Optional ByVal
 sText As String)
Dim s As String, e As Long
   s = String(260, Chr$(0))
   m_itemStyle.hItem = hItem
   m_itemStyle.mask = mask Or TVIF_HANDLE
   m_itemStyle.pszText = sText & vbNullChar
   SendMessage m_hWnd, TVM_SETITEM, 0, m_itemStyle
End Sub



Private Function plSelectedTreeViewStyles() As Long
Dim lStyle As Long

   Select Case m_eTreeViewStyle
   Case etvwTextOnly
   Case etvwPictureText
   Case etvwPlusMinusText
      lStyle = lStyle Or TVS_HASBUTTONS
   Case etvwPlusMinusPictureText
      lStyle = lStyle Or TVS_HASBUTTONS
   Case etvwTreelinesText
      lStyle = lStyle Or TVS_HASLINES
   Case etvwTreelinesPlusMinusText
      lStyle = lStyle Or TVS_HASLINES Or TVS_HASBUTTONS
   Case etvwTreelinesPictureText
      lStyle = lStyle Or TVS_HASLINES
   Case etvwTreelinesPlusMinusPictureText
      lStyle = lStyle Or TVS_HASLINES Or TVS_HASBUTTONS
   End Select
   
   If (m_bCheckBoxes) Then
      lStyle = lStyle Or TVS_CHECKBOXES
   End If
   
   If (m_bFullRowSelect) Then
      lStyle = lStyle Or TVS_FULLROWSELECT
   End If
   
   If Not (m_bScroll) Then
      lStyle = lStyle Or TVS_NOSCROLL
   End If
   
   If Not (m_bHideSelection) Then
      lStyle = lStyle Or TVS_SHOWSELALWAYS
   End If
      
   If (m_eLineStyle = etvwRootLines) Then
      lStyle = lStyle Or TVS_LINESATROOT
   End If
   
   If (m_bSingleSel) Then
      lStyle = lStyle Or TVS_SINGLEEXPAND
   End If
   
   If (m_bLabelEdit) Then
      lStyle = lStyle Or TVS_EDITLABELS
   End If
   
   plSelectedTreeViewStyles = lStyle
   
End Function


Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    ' Convert Automation color to Windows color
    If OleTranslateColor(oClr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function

Private Function plAddressOf(ByVal lPtr As Long)
   plAddressOf = lPtr
End Function

Private Sub pSetStyles()
   
   If Not (m_hWnd = 0) Then
      Dim lStyle As Long
      lStyle = GetWindowLong(hwnd, GWL_STYLE)
      
      lStyle = lStyle And Not (TVS_CHECKBOXES Or TVS_DISABLEDRAGDROP Or _
         TVS_EDITLABELS Or TVS_FULLROWSELECT Or TVS_HASBUTTONS Or _
         TVS_HASLINES Or TVS_INFOTIP Or TVS_LINESATROOT Or TVS_NOSCROLL Or _
         TVS_NOTOOLTIPS Or TVS_SHOWSELALWAYS Or TVS_SINGLEEXPAND Or _
         TVS_TRACKSELECT)
      lStyle = lStyle Or plSelectedTreeViewStyles()
      lStyle = lStyle Or TVS_NOHSCROLL
      
      SetWindowLong m_hWnd, GWL_STYLE, lStyle
      SetWindowPos m_hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or
       SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
   End If
End Sub

Private Sub pInitialize()
Dim lStyle As Long
Dim lExStyle As Long
Dim tR As RECT
Dim hTT As Long

   pTerminate
       
   ' Create the treeview control, filled to our UserControl.
    
    ' Set the style to what we told it to be.
   lStyle = WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or plSelectedTreeViewStyles()
   lExStyle = GetWindowLong(UserControl.hwnd, GWL_EXSTYLE)
   lExStyle = lExStyle And Not WS_EX_CLIENTEDGE
   GetWindowRect UserControl.hwnd, tR
   m_hWnd = CreateWindowEx(lExStyle, _
      WC_TREEVIEW, "", _
      lStyle, 0, 0, tR.right - tR.left, tR.bottom - tR.top, _
      UserControl.hwnd, 0, App.hInstance, 0)
    
   If Not (m_hWnd = 0) Then
      ' Tell the control to try to do version the right thing (message will
       have no effect if
      ' COMCTL32.DLL version < 5.00):
      ComCtlVersion m_lMajor, m_lMinor
      SendMessageL m_hWnd, CCM_SETVERSION, m_lMajor, 0
      ' Set the design-time properties.
      SendMessageL m_hWnd, TVM_SETBKCOLOR, 0, TranslateColor(m_oBackColor)
      SendMessageL m_hWnd, TVM_SETTEXTCOLOR, 0, TranslateColor(m_oForeColor)
      SendMessageL m_hWnd, TVM_SETLINECOLOR, 0, TranslateColor(m_oLineColor)
        
      hTT = SendMessage(m_hWnd, TVM_GETTOOLTIPS, 0, 0)
      SendMessage hTT, TTM_SETTIPBKCOLOR, TranslateColor(m_oTooltipBackColor), 0
      SendMessage hTT, TTM_SETTIPTEXTCOLOR,
       TranslateColor(m_oTooltipForeColor), 0
      SendMessage m_hWnd, TVM_SETINDENT, m_lIndent, 0
      
      ' If it's too early to have set the properties,
      ' ItemHeight will be zero, and ComCtl32.dll will
      ' make a fuss about that, so set it to default (16).
      SendMessage m_hWnd, TVM_SETITEMHEIGHT, m_lItemHeight, 0
      
      SendMessage m_hWnd, WM_SETFONT, m_fnt.hFont, 1
      
      UserControl.BorderStyle = m_eBorderStyle
      
      SetProp UserControl.hwnd, gcOBJECT_PROP, ObjPtr(Me)
      
      Dim hWndToolTips As Long
      hWndToolTips = SendMessageL(m_hWnd, TVM_GETTOOLTIPS, 0, 0)
      If (Not (hWndToolTips) = 0) Then
         SetWindowPos hWndToolTips, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or
          SWP_NOSIZE Or SWP_NOACTIVATE
      End If
      
      On Error GoTo SkipUserMode ' If it's too early for Ambient.
      If Not UserControl.Ambient.UserMode Then
         ' Set up the sample items during design-time:
         ' a root item, a parent item, and 2 children.
         ' This is just a courtesy to the user. A nice one.
         Dim TVIN As TVINSERTSTRUCT
         Dim mRoot As Long
         Dim mParent As Long
         Dim i As Byte
         
         TVIN.hParent = TVI_ROOT
         TVIN.hInsertAfter = TVI_FIRST
         TVIN.Item.pszText = "Root Item" & Chr(0)
         TVIN.Item.cchTextMax = 10
         TVIN.Item.mask = TVIF_TEXT
         mRoot = SendMessage(m_hWnd, TVM_INSERTITEM, 0, TVIN)
         
         TVIN.hParent = mRoot
         TVIN.Item.pszText = "Parent Item" & Chr(0)
         TVIN.Item.cchTextMax = 12
         mParent = SendMessage(m_hWnd, TVM_INSERTITEM, 0, TVIN)
         SendMessage m_hWnd, TVM_EXPAND, TVE_EXPAND, ByVal mRoot
         For i = 1 To 2
            TVIN.hParent = mParent
            TVIN.Item.pszText = "Child Item" & Chr(0)
            TVIN.Item.cchTextMax = 11
            SendMessage m_hWnd, TVM_INSERTITEM, 0, TVIN
         Next
         SendMessage m_hWnd, TVM_EXPAND, TVE_EXPAND, ByVal mParent
         ' Sample items done. Yay.
      End If
      
      UserControl_Resize
      
      If UserControl.Ambient.UserMode Then
         If Not (m_bSubclassed) Then
            ' Subclass it, so we can do sweet stuff.