📄 frmmain.frm
字号:
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 2
Object.Width = 4313
MinWidth = 4304
Picture = "frmMain.frx":B1B8
Text = "文件"
TextSave = "文件"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
TextSave = "2006-1-2"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
TextSave = "0:52"
EndProperty
EndProperty
End
Begin ComCtl3.CoolBar CoolBar1
Align = 1 'Align Top
Height = 735
Left = 0
TabIndex = 0
Top = 0
Width = 11070
_ExtentX = 19526
_ExtentY = 1296
BandCount = 2
_CBWidth = 11070
_CBHeight = 735
_Version = "6.7.8988"
Caption1 = "工具栏"
Child1 = "Toolbar1"
MinHeight1 = 315
Width1 = 3135
NewRow1 = 0 'False
Caption2 = "当前文件夹"
Child2 = "ImageCombo1"
MinHeight2 = 330
Width2 = 630
NewRow2 = -1 'True
Begin MSComctlLib.ImageCombo ImageCombo1
Height = 330
Left = 1125
TabIndex = 5
Top = 375
Width = 9855
_ExtentX = 17383
_ExtentY = 582
_Version = 393216
ForeColor = -2147483640
BackColor = -2147483643
ImageList = "ImageListSmall"
End
Begin MSComctlLib.Toolbar Toolbar1
Height = 315
Left = 765
TabIndex = 2
Top = 30
Width = 10215
_ExtentX = 18018
_ExtentY = 556
ButtonWidth = 609
ButtonHeight = 556
Style = 1
ImageList = "ImageListToolbar"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 9
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "new"
Object.ToolTipText = "新建文件夹或文件"
ImageKey = "new"
Style = 5
BeginProperty ButtonMenus {66833FEC-8583-11D1-B16A-00C0F0283628}
NumButtonMenus = 2
BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628}
Text = "文件夹"
EndProperty
BeginProperty ButtonMenu2 {66833FEE-8583-11D1-B16A-00C0F0283628}
Text = "文件"
EndProperty
EndProperty
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "delete"
Object.ToolTipText = "删除"
ImageKey = "delete"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "foldup"
Object.ToolTipText = "上一级文件夹"
ImageKey = "foldup"
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "icon"
Object.ToolTipText = "大图标"
ImageKey = "icon"
Style = 2
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "smallicon"
Object.ToolTipText = "小图标"
ImageKey = "smallicon"
Style = 2
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "list"
Object.ToolTipText = "列表"
ImageKey = "list"
Style = 2
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "report"
Object.ToolTipText = "详细资料"
ImageKey = "report"
Style = 2
Value = 1
EndProperty
EndProperty
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
Dim fs As Object '声明对象型变量
Dim dc As Object
Dim d As Object
Dim f As Object
Dim sf As Object
Dim newnode As node
Dim s As String
Dim i As Integer
Set fs = CreateObject("Scripting.FilesystemObject") '创建文件系统对象并赋给变量
Set dc = fs.Drives
Tree.Nodes.Add , , "desktop", "桌面", "desktop"
Tree.Nodes.Add "desktop", tvwChild, "mycomp", "我的电脑", "mycomp"
For Each d In dc
If d.DriveType = 1 Then '可移动式驱动器
s = "3.5 软盘"
Set newnode = Tree.Nodes.Add("mycomp", tvwChild, d.Path, s & "( " & d.driveletter & ":)", "floopy")
End If
If d.DriveType = 2 Then '硬盘
If Trim(d.VolumeName) = "" Then
s = "本地硬盘"
Else
s = d.VolumeName
End If
Set newnode = Tree.Nodes.Add("mycomp", tvwChild, d.Path, s & "( " & d.driveletter & ":)", "hard")
End If
If d.DriveType = 4 Then '光驱
If d.IsReady Then
s = Trim(d.VolumeName)
Else
s = "CD驱动器"
End If
Set newnode = Tree.Nodes.Add("mycomp", tvwChild, d.Path, s & "( " & d.driveletter & ":)", "cdrom")
End If
If d.IsReady Then
Set f = d.RootFolder
For Each sf In f.SubFolders
If UCase(sf.Name) = "RECYCLED" Then '回收站文件夹
If sf.SubFolders.Count = 0 And sf.Files.Count = 0 Then
Tree.Nodes.Add newnode, tvwChild, sf.Path, sf.Name, "recyempty"
Else
Tree.Nodes.Add newnode, tvwChild, sf.Path, sf.Name, "recyfull"
End If
ElseIf sf.Name <> "System Volume Information" Then '普通文件夹
Tree.Nodes.Add newnode, tvwChild, sf.Path, sf.Name, "foldclose"
End If
Next
End If
Next
Tree.Nodes("mycomp").Expanded = True
Tree.Nodes("desktop").Expanded = True '展开驱动器层次
End Sub
Private Sub Form_Resize()
Tree.Height = Me.ScaleHeight - StatusBar.Height - Tree.Top
List.Height = Me.ScaleHeight - StatusBar.Height - List.Top
List.Width = Me.ScaleWidth - Tree.Width
End Sub
Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
Dim l As ListItem
Dim fs As Object
Dim f As Object
Dim n As node
If NewString = "" Then MsgBox "文件名无效。", vbExclamation: Exit Sub
For Each l In List.ListItems '检查重名与否
If l.Text = NewString Then
MsgBox "此名称已存在，不能改名。", vbExclamation
Cancel = 1
Exit Sub
End If
Next
Set fs = CreateObject("Scripting.FilesystemObject") '创建文件系统对象并赋给变量
If List.SelectedItem.ListSubItems(1).Text = "文件" Then '为文件更名
Set f = fs.GetFile(Tree.SelectedItem.Key & "\" & List.SelectedItem.Text)
f.Name = NewString
Else '为文件夹更名
Set f = fs.GetFolder(List.Tag & "\" & List.SelectedItem.Text)
Set n = Tree.Nodes(List.Tag & "\" & List.SelectedItem.Text)
f.Name = NewString
n.Text = NewString
n.Key = List.Tag & "\" & NewString
Call rename_node(n)
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "icon"
List.View = lvwIcon
Case "smallicon"
List.View = lvwSmallIcon
Case "list"
List.View = lvwList
Case "report"
List.View = lvwReport
Case "foldup"
Tree.SelectedItem = Tree.Nodes(List.Tag).Parent
Call Tree_NodeClick(Tree.Nodes(List.Tag).Parent)
Case "delete"
Dim fs As Object
Dim f As Object
Dim n As node
Dim i As Integer
Set fs = CreateObject("Scripting.FilesystemObject") '创建文件系统对象并赋给变量
If List.SelectedItem Is Nothing Then Exit Sub
If List.SelectedItem.ListSubItems(1).Text = "文件" Then '删除文件
If MsgBox("是否要永久删除文件：" & List.Tag & "\" & List.SelectedItem.Text & "？", vbExclamation + vbYesNo + vbDefaultButton2) = vbYes Then
fs.DeleteFile List.Tag & "\" & List.SelectedItem.Text, True '从盘上删除文件
List.ListItems.Remove List.SelectedItem.Index '在列表中删除文件名
End If
Else '删除文件夹
If MsgBox("是否要永久删除文件夹：" & List.Tag & "\" & List.SelectedItem.Text & "？", vbExclamation + vbYesNo + vbDefaultButton2) = vbYes Then
Tree.Nodes.Remove List.Tag & "\" & List.SelectedItem.Text '删除树型视图中的相应节点
fs.DeleteFolder List.Tag & "\" & List.SelectedItem.Text, True '从盘上删除文件夹（及其所有子文件夹与文件）
List.ListItems.Remove List.SelectedItem.Index '在列表中删除文件夹名
End If
End If
End Select
End Sub
Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Dim fs As Object
Dim f As Object
Dim n As node
Dim i As Integer
Dim l As ListItem
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -