home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1779.psc / Form.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-11-11  |  8.5 KB  |  204 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form Form1 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "DirTreeView"
  6.    ClientHeight    =   5730
  7.    ClientLeft      =   1950
  8.    ClientTop       =   1590
  9.    ClientWidth     =   6315
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   5730
  14.    ScaleWidth      =   6315
  15.    Begin VB.CommandButton Command1 
  16.       Caption         =   "Go"
  17.       Height          =   255
  18.       Left            =   5880
  19.       TabIndex        =   3
  20.       Top             =   5420
  21.       Width           =   375
  22.    End
  23.    Begin VB.TextBox Text1 
  24.       Height          =   285
  25.       Left            =   20
  26.       TabIndex        =   2
  27.       Text            =   "c:\dokumenty"
  28.       Top             =   5400
  29.       Width           =   5760
  30.    End
  31.    Begin VB.ListBox List1 
  32.       Height          =   1425
  33.       Left            =   2520
  34.       Sorted          =   -1  'True
  35.       TabIndex        =   1
  36.       Top             =   3000
  37.       Visible         =   0   'False
  38.       Width           =   1935
  39.    End
  40.    Begin MSComctlLib.ImageList img 
  41.       Left            =   1320
  42.       Top             =   3000
  43.       _ExtentX        =   1005
  44.       _ExtentY        =   1005
  45.       BackColor       =   -2147483643
  46.       ImageWidth      =   16
  47.       ImageHeight     =   16
  48.       MaskColor       =   128
  49.       _Version        =   393216
  50.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  51.          NumListImages   =   8
  52.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  53.             Picture         =   "Form.frx":0000
  54.             Key             =   "unknown"
  55.          EndProperty
  56.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  57.             Picture         =   "Form.frx":0944
  58.             Key             =   "fixed"
  59.          EndProperty
  60.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  61.             Picture         =   "Form.frx":30F8
  62.             Key             =   "ram"
  63.          EndProperty
  64.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  65.             Picture         =   "Form.frx":58AC
  66.             Key             =   "remove"
  67.          EndProperty
  68.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  69.             Picture         =   "Form.frx":8060
  70.             Key             =   "cd"
  71.          EndProperty
  72.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  73.             Picture         =   "Form.frx":A814
  74.             Key             =   "folder"
  75.          EndProperty
  76.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  77.             Picture         =   "Form.frx":CFC8
  78.             Key             =   "open"
  79.          EndProperty
  80.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  81.             Picture         =   "Form.frx":F77C
  82.             Key             =   "remote"
  83.          EndProperty
  84.       EndProperty
  85.    End
  86.    Begin MSComctlLib.TreeView DirTree 
  87.       Height          =   5295
  88.       Left            =   20
  89.       TabIndex        =   0
  90.       Top             =   30
  91.       Width           =   6285
  92.       _ExtentX        =   11086
  93.       _ExtentY        =   9340
  94.       _Version        =   393217
  95.       Indentation     =   529
  96.       LabelEdit       =   1
  97.       LineStyle       =   1
  98.       Style           =   7
  99.       ImageList       =   "img"
  100.       Appearance      =   1
  101.    End
  102. Attribute VB_Name = "Form1"
  103. Attribute VB_GlobalNameSpace = False
  104. Attribute VB_Creatable = False
  105. Attribute VB_PredeclaredId = True
  106. Attribute VB_Exposed = False
  107. ' Author: Marek Letosnik
  108. ' letosnik@atlas.cz
  109. Private nNode As Node
  110. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
  111. Private Sub Command1_Click()
  112. Dim Strom As String, Where As String, h As Integer
  113.   Where = Text1
  114.   h = 1
  115. Znova:
  116.     Strom = LCase(Mid(DirTree.Nodes(h).FullPath, InStr(1, DirTree.Nodes(h).FullPath, ":") - 1, 2) & Mid(DirTree.Nodes(h).FullPath, InStr(1, DirTree.Nodes(h).FullPath, ":") + 2))
  117.     If Left(LCase(Where), Len(Strom)) = LCase(Strom) Then
  118.         DirTree.Nodes(h).Expanded = True
  119.         If DirTree.Nodes(h).Children > 0 Then h = DirTree.Nodes(h).Child.Index Else Exit Do
  120.         GoTo Znova
  121.         Exit Do
  122.     End If
  123.     If h = DirTree.Nodes(h).LastSibling.Index Then Exit Do
  124.     h = DirTree.Nodes(h).Next.Index
  125.   Loop
  126. End Sub
  127. Private Sub DirTree_Expand(ByVal Node As MSComctlLib.Node)
  128. Dim j As Integer
  129.     For j = Node.Child.FirstSibling.Index To Node.Child.LastSibling.Index
  130.         DirTree_NodeClick DirTree.Nodes(j)
  131.     Next j
  132.     DirTree_NodeClick Node
  133.     Node.Selected = True
  134. End Sub
  135. Private Sub DirTree_KeyDown(KeyCode As Integer, Shift As Integer)
  136.     If KeyCode = vbKeyF5 Then DirTree.Nodes.Clear: LoadTreeView
  137. End Sub
  138. Private Sub Form_Load()
  139.     LoadTreeView
  140. End Sub
  141. Private Sub DirTree_NodeClick(ByVal Node As MSComctlLib.Node)
  142.     Dim Path As String
  143.     If Left(Node.Key, 4) = "root" Then
  144.         On Error Resume Next
  145.         If Node.Children > 0 Then GoTo Skok
  146.         DisplayDir Mid(Node.Text, Len(Node.Text) - 2, 2), Node.Key
  147.     End If
  148.     Path = Mid(Node.FullPath, InStr(1, Node.FullPath, ":") - 1, 2) & Mid(Node.FullPath, InStr(1, Node.FullPath, ":") + 2)
  149.     If Node.Children > 0 Then GoTo Skok
  150.     DisplayDir Path, Node.Index
  151. Skok:
  152.     Path = Mid(Node.FullPath, InStr(1, Node.FullPath, ":") - 1, 2) & Mid(Node.FullPath, InStr(1, Node.FullPath, ":") + 2)
  153.     If Right(Path, 1) <> "\" Then Path = Path & "\"
  154.     Text1 = Path
  155. End Sub
  156. Sub DisplayDir(Pth, Parent)
  157. Dim j As Integer
  158.     On Error Resume Next
  159.     Pth = Pth & "\"
  160.     tmp = Dir(Pth, vbDirectory)
  161.     Do Until tmp = ""
  162.         If tmp <> "." And tmp <> ".." Then
  163.             If GetAttr(Pth & tmp) And vbDirectory Then
  164.                 'I use ListBox with property Sorted=True to
  165.                 'alphabetize directories. Easy eh? ;-)
  166.                 List1.AddItem StrConv(tmp, vbProperCase)
  167.                 'StrConv function convert for example
  168.                 '"WINDOWS" to "Windows"
  169.             End If
  170.         End If
  171.         tmp = Dir
  172.     Loop
  173.     'Add sorted directory names to TreeView
  174.     For j = 1 To List1.ListCount
  175.         Set nNode = DirTree.Nodes.Add(Parent, tvwChild, , List1.List(j - 1), "folder")
  176.         nNode.ExpandedImage = "open"
  177.     Next j
  178.     List1.Clear
  179. End Sub
  180. Private Sub LoadTreeView()
  181.     Dim DriveNum As String
  182.     Dim DriveType As Long
  183.     DriveNum = 64
  184.     On Error Resume Next
  185.     Do
  186.         DriveNum = DriveNum + 1
  187.         DriveType = GetDriveType(Chr$(DriveNum) & ":\")
  188.         If DriveNum > 90 Then Exit Do
  189.         Select Case DriveType
  190.             Case 0: Set nNode = DirTree.Nodes.Add(, , "root" & DriveNum, StrConv(Dir(Chr$(DriveNum) & ":", vbVolume), vbProperCase) & " (" & Chr$(DriveNum) & ":)", "unknown")
  191.                     DisplayDir Mid(DirTree.Nodes("root" & DriveNum).Text, Len(DirTree.Nodes("root" & DriveNum).Text) - 2, 2), "root" & DriveNum
  192.             Case 2: Set nNode = DirTree.Nodes.Add(, , "root" & DriveNum, "(" & Chr$(DriveNum) & ":)", "remove")
  193.             Case 3: Set nNode = DirTree.Nodes.Add(, , "root" & DriveNum, StrConv(Dir(Chr$(DriveNum) & ":", vbVolume), vbProperCase) & " (" & Chr$(DriveNum) & ":)", "fixed")
  194.                     DisplayDir Mid(DirTree.Nodes("root" & DriveNum).Text, Len(DirTree.Nodes("root" & DriveNum).Text) - 2, 2), "root" & DriveNum
  195.             Case 4: Set nNode = DirTree.Nodes.Add(, , "root" & DriveNum, StrConv(Dir(Chr$(DriveNum) & ":", vbVolume), vbProperCase) & " (" & Chr$(DriveNum) & ":)", "remote")
  196.                     DisplayDir Mid(DirTree.Nodes("root" & DriveNum).Text, Len(DirTree.Nodes("root" & DriveNum).Text) - 2, 2), "root" & DriveNum
  197.             Case 5: Set nNode = DirTree.Nodes.Add(, , "root" & DriveNum, StrConv(Dir(Chr$(DriveNum) & ":", vbVolume), vbProperCase) & " (" & Chr$(DriveNum) & ":)", "cd")
  198.                     DisplayDir Mid(DirTree.Nodes("root" & DriveNum).Text, Len(DirTree.Nodes("root" & DriveNum).Text) - 2, 2), "root" & DriveNum
  199.             Case 6: Set nNode = DirTree.Nodes.Add(, , "root" & DriveNum, StrConv(Dir(Chr$(DriveNum) & ":", vbVolume), vbProperCase) & " (" & Chr$(DriveNum) & ":)", "ram")
  200.                     DisplayDir Mid(DirTree.Nodes("root" & DriveNum).Text, Len(DirTree.Nodes("root" & DriveNum).Text) - 2, 2), "root" & DriveNum
  201.         End Select
  202.     Loop
  203. End Sub
  204.