vbAccelerator - Contents of code file: frmDirectories.frm

VERSION 5.00
Object = "{CA5A8E1E-C861-4345-8FF8-EF0A27CD4236}#1.1#0"; "vbalTreeView6.ocx"
Begin VB.Form frmDirectories 
   Caption         =   "vbAccelerator Shell Directories Demonstration"
   ClientHeight    =   8010
   ClientLeft      =   4875
   ClientTop       =   3540
   ClientWidth     =   6090
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmDirectories.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8010
   ScaleWidth      =   6090
   Begin VB.TextBox txtSelected 
      Height          =   285
      Left            =   120
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   7620
      Width           =   5835
   End
   Begin vbalTreeViewLib6.vbalTreeView tvwDirs 
      Height          =   7515
      Left            =   120
      TabIndex        =   0
      Top             =   60
      Width           =   5835
      _ExtentX        =   10292
      _ExtentY        =   13256
      DragAutoExpand  =   -1
      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
End
Attribute VB_Name = "frmDirectories"
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 Sub Form_Load()
   ' Create a System Image List:
   Set m_cIml = New cVBALSysImageList
   m_cIml.IconSizeX = 16
   m_cIml.IconSizeY = 16
   m_cIml.Create
   tvwDirs.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.IsFolder) And (driveItem.IsFileSystem) Then
         m_lID = m_lID + 1
         sKey = m_lID & ":" & driveItem.Path
         Set nod = tvwDirs.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"
      End If
   Next

End Sub

Private Sub Form_Resize()
   '
   On Error Resume Next
   tvwDirs.Move tvwDirs.left, tvwDirs.tOp, _
      Me.ScaleWidth - tvwDirs.left * 2, _
      Me.ScaleHeight - tvwDirs.tOp * 3 - txtSelected.Height
   txtSelected.Move tvwDirs.left, tvwDirs.tOp * 2 + tvwDirs.Height, _
      tvwDirs.Width
   '
End Sub

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

      Dim items As Folder
      Dim itm As FolderItem
      Dim nod As cTreeViewNode
      Dim sKey As String
      Dim iPos As Long
      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.IsFolder) And (itm.IsFileSystem) Then
               m_lID = m_lID + 1
               sKey = m_lID & ":" & itm.Path
               Set nod = node.Children.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"
            End If
         Next
      End If
      Screen.MousePointer = vbDefault
      
   End If
   '
End Sub

Private Sub tvwDirs_SelectedNodeChanged()
Dim sKey As String
Dim iPos As Long
Dim sPath As String
   sKey = tvwDirs.SelectedItem.Key
   iPos = InStr(sKey, ":")
   sPath = Mid(sKey, iPos + 1)
   txtSelected.Text = tvwDirs.SelectedItem.Text & " (" & sPath & ")"
End Sub