vbAccelerator - Contents of code file: frmMultiSelectTree.frm

VERSION 5.00
Object = "{CA5A8E1E-C861-4345-8FF8-EF0A27CD4236}#1.1#0"; "vbalTreeView6.ocx"
Begin VB.Form frmMultiSelectTree 
   Caption         =   "vbAccelerator MultiSelect TreeView"
   ClientHeight    =   5250
   ClientLeft      =   4335
   ClientTop       =   2535
   ClientWidth     =   5100
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMultiSelectTree.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   5100
   Begin vbalTreeViewLib6.vbalTreeView tvwMultiSelect 
      Height          =   4455
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   4875
      _ExtentX        =   8599
      _ExtentY        =   7858
      NoCustomDraw    =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmMultiSelectTree.frx":45A2
      Height          =   675
      Left            =   120
      TabIndex        =   1
      Top             =   60
      Width           =   4935
   End
   Begin VB.Menu mnuContextTOP 
      Caption         =   ""
      Visible         =   0   'False
      Begin VB.Menu mnuContext 
         Caption         =   "&Selected Items..."
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmMultiSelectTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cIml As New cVBALSysImageList
Private m_lID As Long
Private m_shl As New Shell

Private m_cTreeViewMultiSelect As cTreeViewMultiSelect


Private Sub Form_Load()
      
   Set m_cTreeViewMultiSelect = New cTreeViewMultiSelect
   m_cTreeViewMultiSelect.Attach tvwMultiSelect
      
   ' Create a System Image List:
   Set m_cIml = New cVBALSysImageList
   m_cIml.IconSizeX = 16
   m_cIml.IconSizeY = 16
   m_cIml.Create
   tvwMultiSelect.ImageList = m_cIml.hIml

   ' Enumerate the shell's desktop folder for files
   Dim drives As Folder
   Set drives = m_shl.NameSpace(ssfDRIVES)
   Dim driveItem As FolderItem
   Dim nod As cTreeViewNode
   Dim count As Long
   Dim sKey As String
   For Each driveItem In drives.items
      If (driveItem.IsFileSystem) Then
         If (driveItem.IsFolder) Then
            m_lID = m_lID + 1
            sKey = m_lID & ":" & driveItem.Path
            Set nod = tvwMultiSelect.nodes.Add(, , sKey, driveItem.Name, _
               m_cIml.ItemIndex(driveItem.Path, True))
            nod.ItemData = 0
            m_lID = m_lID + 1
            nod.Children.Add , , "TODO:" & m_lID, "Unexpanded"
         Else
            m_lID = m_lID + 1
            sKey = m_lID & ":" & driveItem.Path
            Set nod = tvwMultiSelect.nodes.Add(, , sKey, driveItem.Name, _
               m_cIml.ItemIndex(driveItem.Path, True))
            nod.ItemData = 1
         End If
      End If
   Next

End Sub

Private Sub Form_Resize()
   
   On Error Resume Next
   tvwMultiSelect.Move tvwMultiSelect.left, tvwMultiSelect.tOp, _
      Me.ScaleWidth - tvwMultiSelect.left * 2, _
      Me.ScaleHeight - tvwMultiSelect.tOp - lblInfo.tOp * 2
   lblInfo.Width = tvwMultiSelect.Width
      
End Sub

Private Sub mnuContext_Click(Index As Integer)
Dim sMsg As String
Dim i As Long

   Select Case Index
   Case 0
      sMsg = "Selected Items: "
      If (m_cTreeViewMultiSelect.SelectionCount > 0) Then
         sMsg = sMsg & m_cTreeViewMultiSelect.SelectionCount
         For i = 1 To m_cTreeViewMultiSelect.SelectionCount
            sMsg = sMsg & vbCrLf & vbTab &
             m_cTreeViewMultiSelect.SelectedNode(i).Text
         Next i
      Else
         sMsg = sMsg & "None"
      End If
      MsgBox sMsg, vbInformation
   End Select
End Sub

Private Sub tvwMultiSelect_BeforeExpand(node As vbalTreeViewLib6.cTreeViewNode,
 cancel As Boolean)
   '
   If InStr(node.FirstChild.Key, "TODO:") = 1 Then
      
      Screen.MousePointer = vbHourglass
      
      node.Children.Remove 1

      Dim items As Folder
      Dim itm As FolderItem
      Dim nod As cTreeViewNode
      Dim sKey As String
      Dim iPos As Long
      Dim nodes As cTreeViewNodes
      Set nodes = node.Children
      
      sKey = node.Key
      iPos = InStr(sKey, ":")
      sKey = Mid(sKey, iPos + 1)
      Set items = m_shl.NameSpace(sKey)
      If Not items Is Nothing Then
         For Each itm In items.items
            If (itm.IsFileSystem) Then
               If (itm.IsFolder) Then
                  m_lID = m_lID + 1
                  sKey = m_lID & ":" & itm.Path
                  Set nod = nodes.Add(, , sKey, itm.Name, _
                  m_cIml.ItemIndex(itm.Path, True))
                  nod.ItemData = 0
                  m_lID = m_lID + 1
                  nod.Children.Add , , "TODO:" & m_lID, "Unexpanded"
               Else
                  m_lID = m_lID + 1
                  sKey = m_lID & ":" & itm.Path
                  Set nod = nodes.Add(, , sKey, itm.Name, _
                     m_cIml.ItemIndex(itm.Path, True))
                  nod.ItemData = 1
               End If
            End If
         Next
      End If
      
      node.Sort etvwItemDataThenAlphabetic
      
      Screen.MousePointer = vbDefault
      
   End If
   '
End Sub

Private Sub tvwMultiSelect_NodeRightClick(node As
 vbalTreeViewLib6.cTreeViewNode)
   Me.PopupMenu mnuContextTOP
End Sub