控件-treeview(含本程序的源代码)
'这就是本程序的源代码，主要就是利用treeview控件实现了点击左边，右边出现文本
Private Sub Form_Load()
a = 读取文件("使用说明.txt")
b = Split(a, vbCrLf)
Text4 = b(0)
Dim nodX As Node '声明 Node 变量。
Set nodX = TreeView1.Nodes.Add(, , Text4, Text4) '建立顶级目录树
Me.Show
Text2 = App.Path & "\" & Text4
路径 = Text2.Text
搜索子文件夹 (路径) '把子目录的路径记录入text2中，路径不能多行
Text2 = 建立文件夹目录树(路径) '根据顶级目录树延伸的第二级目录树
再次建立目录树 '重复几次，就多几级目录树。但最少得从第三级开始
再次建立目录树
再次建立目录树
再次建立目录树
再次建立目录树
再次建立目录树
再次建立目录树
End Sub
Public Function 搜索文件夹(ByVal 当前目录0其他路径字符串 As String) As String() '如果是当前目录就输入0，否则输入字符串。返回下一级文件夹的数组
On Error Resume Next
Dim strFile As String
k = ""
If 当前目录0其他路径字符串 = "" Then Exit Function
If 当前目录0其他路径字符串 = "0" Then 当前目录0其他路径字符串 = App.Path
If Right(当前目录0其他路径字符串, 1) <> "\" Then 当前目录0其他路径字符串 = 当前目录0其他路径字符串 + "\"
strFile = Dir(当前目录0其他路径字符串, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
While strFile <> ""
DoEvents
If (GetAttr(当前目录0其他路径字符串 + strFile) And vbDirectory) = vbDirectory Then
If strFile <> "." And strFile <> ".." Then k = k & strFile & ","
End If
strFile = Dir
Wend
搜索文件夹 = Split(k, ",")
End Function
Public Function 建立文件夹目录树(ByVal 路径名 As String)
On Error Resume Next
TreeView1.LineStyle = tvwRootLines ' Linestyle 1
Dim nodX As Node '声明 Node 变量。
a = Split(路径名, "\")
b = UBound(a)
If b - 1 < 0 Then '防止没有下一级目录，引起下标越界
Exit Function
Else
父目录 = a(b)
End If
a = a(UBound(a)) '获取路径中最后的文件夹名称
c = Split(搜索子文件夹(路径名 & "\"), vbCrLf)
For i = 0 To UBound(c)
d = Split(c(i), "\")
e = d(UBound(d))
Set nodX = TreeView1.Nodes.Add(父目录, tvwChild, e, e)
f = f & 路径名 & "\" & e & vbCrLf
Next
建立文件夹目录树 = f
End Function
Public Function 搜索文件(ByVal 文件夹路径 As String, 文件类型 As String)
'* 星号表示多个任意字符
'搜索文件 "C:\Program Files\WinRAR\", "*" '查找所有文件
'搜索文件 "C:\Program Files\WinRAR\", "*.exe" '查找所有exe文件
'搜索文件 "C:\Program Files\WinRAR\", "*in*.exe" '查找文件名中包含有 in 的exe文件
Dim 文件() As String '文件路径
Dim 文件夹() As String '文件夹路径
Dim a, b, c As Long
Dim sPath, wjlb As String
If Ri
ght(文件夹路径, 1) <> "\" Then 文件夹路径 = 文件夹路径 & "\"
sPath = Dir(文件夹路径 & 文件类型) '查找第一个文件
Do While Len(sPath) '循环到没有文件为止
a = a + 1
ReDim Preserve 文件(1 To a)
文件(a) = 文件夹路径 & sPath '将文件目录和文件名组合,并存放到数组中
wjlb = wjlb & 文件(a) & vbCrLf '保存文件列表
sPath = Dir '查找下一个文件
DoEvents '让出控制权
Loop
搜索文件 = wjlb
End Function
Public Function 搜索子文件夹(ByVal 文件夹路径 As String)
On Error Resume Next
Dim 文件() As String '文件路径
Dim 文件夹() As String '文件夹路径
Dim a, b, c As Long
Dim sPath, wjlb As String
If Right(文件夹路径, 1) <> "\" Then 文件夹路径 = 文件夹路径 & "\"
sPath = Dir(文件夹路径 & "\", vbDirectory) '查找第一个文件夹
If Len(sPath) = 0 Then Exit Function
Do While Len(sPath) '循环到没有文件夹为止
sPath = Dir '查找下一个文件夹
cd = Len(sPath)
If cd > 2 Then wjlb = wjlb & 文件夹路径 & sPath & vbCrLf
DoEvents '让出控制权
Loop
搜索子文件夹 = wjlb
End Function
Public Function 再次建立目录树()
a = Text2.Text
b = Split(a, vbCrLf)
'If UBound(b) = 0 Then Exit Function
For i = 0 To UBound(b)
c = c & 建立文件夹目录树(b(i))
Next i
Text2 = c
End Function
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
If TreeView1.SelectedItem.Children = 0 Then '检查是否有子节点,0为无
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then
Text3.Text = TreeView1.SelectedItem.FullPath
Text1 = 读取文件(Text3.Text)
Clipboard.Clear '清空剪贴板
Clipboard.SetText Text1.Text '将变量文本赋给剪贴板
End If
Next i
End If
End Sub
Public Function 读取文件(ByVal 文件名 As String) As String
文件名 = App.Path & "\" & 文件名 '& ".txt"
Open 文件名 For Input As #1 '若无文件会出错，有提示
Dim str As String
While (Not EOF(1)) '若没有到达文件尾
Line Input #1, str '则赋值给str
b = b & str & vbCrLf
Wend
Close #1
读取文件 = b
End Function
'-------------------------本程序的源代码完毕------------------------
'说明：很多功能都还没有收集完,还在完善中...
'新建一个"code.ini"文本文档,将文本一行行写入文本文档中(第一个层次分隔符以"#"号打头)
'举例：
'#gml##根目录
'#yjzml##一级子目录
'#ejzml##二级子目录
'#sjzml##三级子目录
'层次等级排列必须从大到小排列(例子中"根目录"最大，"三级子目录"最小，不能跨级排列)
Dim zifu As String '装载所有代码内容
Dim genmulu As Integer '根目录编号
Dim yijizimulu As
Integer '一级子目录编号
Dim erjizimulu As Integer '二级子目录编号
Dim sanjizimulu As Integer '三级子目录编号
'Dim sijizimulu As Integer '四级子目录编号
Private Sub Form_Load() '将数据导入到TreeView控件中
TreeView1.LineStyle = tvwRootLines 'node对像之间显示的行样式
TreeView1.Indentation = 300 '树视图控件的缩进宽度
'--------------------------------------------------------------------------------------------------------TreeView基本设置
Open App.Path & "\" & "code.ini" For Binary As #1
zifu = Input(LOF(1), 1)
Close #1
'--------------------------------------------------------------------------------------------------------加载内容到字符串变量中
Dim a
Dim i As Integer
a = Split(zifu, vbCrLf)
For i = LBound(a) To UBound(a)
If Left(a(i), 6) = "#gml##" Then
genmulu = genmulu + 1
TreeView1.Nodes.Add , , "genmulu" & genmulu, Split(Split(a(i), "##")(1), "#")(0)
'------------------------------------------------------------------------------------------------新建根目录
End If
If Left(a(i), 8) = "#yjzml##" Then
yijizimulu = yijizimulu + 1
TreeView1.Nodes.Add "genmulu" & genmulu, tvwChild, "yijizimulu" & yijizimulu, Split(Split(a(i), "##")(1), "#")(0)
'------------------------------------------------------------------------------------------------新建一级子目录
End If
If Left(a(i), 8) = "#ejzml##" Then
erjizimulu = erjizimulu + 1
TreeView1.Nodes.Add "yijizimulu" & yijizimulu, tvwChild, "erjizimulu" & erjizimulu, Split(Split(a(i), "##")(1), "#")(0)
'------------------------------------------------------------------------------------------------新建二级子目录
End If
If Left(a(i), 8) = "#sjzml##" Then
sanjizimulu = sanjizimulu + 1
TreeView1.Nodes.Add "erjizimulu" & erjizimulu, tvwChild, "sanjizimulu" & sanjizimulu, Split(Split(a(i), "##")(1), "#")(0)
'------------------------------------------------------------------------------------------------新建三级子目录
End If
Next i
'--------------------------------------------------------------------------------------------------------将符合条件的内容导入控件
'For Each Node In TreeView1.Nodes
'Node.Expanded = True
'Next
'--------------------------------------------------------------------------------------------------------展开目录树
'TreeView1.SelectedItem.Text'当前选中行的文字
'ListView1.ListItems.Count '总行数
End Sub