?? fileview.frm
字號:
TextSave = "Ti52e:09:52"
Key = "time"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
Alignment = 1
Object.Width = 2117
MinWidth = 2117
TextSave = "2001-12-23"
Key = "date"
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
AutoSize = 1
Bevel = 0
Enabled = 0 'False
Object.Width = 2717
MinWidth = 1764
Text = "資源管理器"
TextSave = "資源管理器"
Key = "welcome"
EndProperty
EndProperty
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuFileCreate
Caption = "新建(&N)"
Begin VB.Menu mnuFileFldr
Caption = "文件夾"
End
Begin VB.Menu mnuFileTxt
Caption = "文本文件"
End
End
Begin VB.Menu mnuFileLine0
Caption = "-"
End
Begin VB.Menu mnuEditDel
Caption = "刪除(&D)"
End
Begin VB.Menu mnuEditReN
Caption = "重命名(&M)"
End
Begin VB.Menu mnuFileClose
Caption = "關閉(&C)"
End
End
Begin VB.Menu mnuEdit
Caption = "編輯(&E)"
Begin VB.Menu mnuEditCopy
Caption = "復制(&C)"
Shortcut = ^C
End
Begin VB.Menu mnuEditCut
Caption = "剪切(&T)"
Shortcut = ^X
End
Begin VB.Menu mnuEditPaste
Caption = "粘貼(&P)"
Shortcut = ^V
End
Begin VB.Menu munEditLine1
Caption = "-"
End
Begin VB.Menu mnuEditLine2
Caption = "-"
End
Begin VB.Menu mnuEditSelAll
Caption = "全選(&A)"
Shortcut = ^A
End
Begin VB.Menu mnuFileSelR
Caption = "反向選擇(&I)"
End
End
Begin VB.Menu mnuView
Caption = "查看(&V)"
Begin VB.Menu mnuViewTB
Caption = "工具欄"
Checked = -1 'True
End
Begin VB.Menu mnuFileSB
Caption = "狀態欄"
Checked = -1 'True
End
Begin VB.Menu mnuViewLine0
Caption = "-"
End
Begin VB.Menu mnuViewLi
Caption = "大圖標"
End
Begin VB.Menu mnuViewSi
Caption = "小圖標"
End
Begin VB.Menu mnuViewList
Caption = "列表"
End
Begin VB.Menu mnuViewDetail
Caption = "詳細資料"
End
Begin VB.Menu mnuViewLine1
Caption = "-"
End
Begin VB.Menu mnuViewRf
Caption = "刷新(&R)"
Shortcut = {F5}
End
Begin VB.Menu mnuViewLine2
Caption = "-"
End
Begin VB.Menu mnuViewUp
Caption = "上一級"
End
End
Begin VB.Menu Help
Caption = "幫助(&H)"
Begin VB.Menu About
Caption = "關于 資源管理器(&A)"
End
End
Begin VB.Menu mnuPop
Caption = ""
Begin VB.Menu mnuFileCreatepop
Caption = "新建(&N)"
Begin VB.Menu mnuFileFldrpop
Caption = "文件夾"
End
Begin VB.Menu mnuFileTxtpop
Caption = "文本文件"
End
End
Begin VB.Menu mnuFileLine0pop
Caption = "-"
End
Begin VB.Menu mnuEditCopypop
Caption = "復制(&C)"
End
Begin VB.Menu mnuEditCutpop
Caption = "剪切(&T)"
End
Begin VB.Menu mnuEditPastepop
Caption = "粘貼(&P)"
End
Begin VB.Menu mnuEditLine2pop
Caption = "-"
End
Begin VB.Menu mnuEditDelpop
Caption = "刪除(&D)"
End
Begin VB.Menu mnuEditLine3pop
Caption = "-"
End
Begin VB.Menu mnuEditReNpop
Caption = "重命名(&M)"
End
Begin VB.Menu mnuEditLine4pop
Caption = "-"
End
Begin VB.Menu mnuEditSelAllpop
Caption = "全選(&A)"
End
Begin VB.Menu mnuFileSelRpop
Caption = "反向選擇(&I)"
End
Begin VB.Menu mnuLine1
Caption = "-"
End
Begin VB.Menu mnuViewUppop
Caption = "上一級"
End
End
End
Attribute VB_Name = "frmFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_sngtvwWidth As Single
'判斷邊界的移動
Private m_bMove As Boolean
Private m_lItems As ListItems
'判斷ListItem的雙擊
Private m_sngtmDClk As Single
Private m_bFClk As Boolean
'當前Node
Private m_ndCur As Node
'誰得焦點
Private m_bFocus As Boolean
'復制、剪切
Private m_bCopy As Boolean
Private m_arrayflPath() As String
Private m_arrayfldrPath() As String
'動畫
Private m_bStop As Boolean
Private Sub clbForm_HeightChanged(ByVal NewHeight As Single)
PlayOut
End Sub
Private Sub Form_Load()
m_sngtvwWidth = frmFile.ScaleWidth / 3
m_bMove = False
m_bFClk = False
m_bBak = False
'treeview得焦點
m_bFocus = True
m_bStop = False
Dim m_arrayflPath(1) As String
Dim m_arrayfldrPath(1) As String
m_arrayflPath(0) = ""
m_arrayfldrPath(0) = ""
ReadDir
lvwFile.ColumnHeaders.Add , "Name", "名稱", lvwFile.Width * 2
lvwFile.ColumnHeaders.Add , "Size", "大小", lvwFile.Width
lvwFile.ColumnHeaders.Add , "Type", "類型", lvwFile.Width
lvwFile.ColumnHeaders.Add , "MDate", "修改時間", lvwFile.Width * 2
lvwFile.View = lvwReport
tvwFile.Nodes("C:\").Selected = True
ImageCombo1_Dropdown
tvwFile_NodeClick tvwFile.Nodes("C:\")
tvwFile.Nodes("C:\").Expanded = True
tvwFile.Nodes("C:\").Selected = True
'保存當前node
Set m_ndCur = tvwFile.Nodes("C:\")
End Sub
'讀出文件系統出來，放于TreeView中
Private Sub ReadDir()
'圖像索引號
Dim intimgindex As Integer
'父節點
Dim strParent As String
Dim nd As Node
'創建文件系統對象
Set fso = CreateObject("scripting.filesystemobject")
Set drvs = fso.Drives
Set nd = tvwFile.Nodes.Add(, 0, "desktop", "桌面", 1, 1)
nd.Tag = 4
Set nd = tvwFile.Nodes.Add("desktop", 4, "mycomp", "我的電腦", 2, 2)
nd.Tag = 3
For Each drv In drvs
Select Case drv.DriveType
Case CDRom
intimgindex = 5
Case RamDisk
intimgindex = 4
Case Removable
intimgindex = 3
Case Network
intimgindex = 9
Case Unknown
intimgindex = 4
Case Fixed
intimgindex = 4
End Select
If drv.DriveType = Fixed Then
Set nd = tvwFile.Nodes.Add("mycomp", 4, drv.path, drv.DriveLetter + "(" + drv.VolumeName + ")", intimgindex, intimgindex)
Else
Set nd = tvwFile.Nodes.Add("mycomp", 4, drv.path, drv.DriveLetter, intimgindex, intimgindex)
End If
nd.Key = nd.Key & "\"
nd.Tag = 2
'文件夾
intimgindex = 6
If drv.DriveType <> Removable Then
If drv.IsReady Then
'開始讀取
strParent = drv.path + "\"
Set fldr = drv.RootFolder
Set fldrs = fldr.SubFolders
'有子文件夾
For Each fldr1 In fldrs
Set nd = tvwFile.Nodes.Add(strParent, 4, fldr1.path, fldr1.Name, intimgindex, intimgindex)
nd.Tag = 0
NextNode fldr1.path, fldr1
Next
End If
End If
Next
End Sub
Private Sub NextNode(Parent As String, ByVal folder As Scripting.folder)
Dim nd As Node
If folder.SubFolders.Count <> 0 Then
Set fldrs = folder.SubFolders
For Each fldr1 In fldrs
Set nd = tvwFile.Nodes.Add(Parent, 4, fldr1.path, fldr1.Name, 6, 6)
nd.Tag = 0
'窮盡所有的子文件夾
'NextNode fldr1.Path, fldr1
Next
End If
End Sub
Private Sub Form_Resize()
PlayOut
End Sub
Private Sub PlayOut()
Dim sngheight As Single
'窗體布局
If frmFile.WindowState <> 1 Then
tvwFile.Left = 0
sngheight = frmFile.ScaleHeight
If clbForm.Visible Then
sngheight = sngheight - clbForm.Height
tvwFile.Top = clbForm.Height
Else
tvwFile.Top = 0
End If
If stbForm.Visible Then
sngheight = sngheight - stbForm.Height
End If
tvwFile.Height = sngheight
tvwFile.Width = m_sngtvwWidth
lvwFile.Top = tvwFile.Top
lvwFile.Left = tvwFile.Width
lvwFile.Height = tvwFile.Height
lvwFile.Width = frmFile.ScaleWidth - tvwFile.Width
End If
End Sub
Private Sub ImageCombo1_Click()
tvwFile_NodeClick tvwFile.Nodes(ImageCombo1.SelectedItem.Key)
tvwFile.Nodes(ImageCombo1.SelectedItem.Key).Expanded = True
tvwFile.Nodes(ImageCombo1.SelectedItem.Key).EnsureVisible
End Sub
Private Sub ImageCombo1_Dropdown()
Dim cmbitem As ComboItem
Dim nd As Node
Dim fullPath As String
Dim subPath() As String
Dim rootPath As String
Dim intlocal As Integer
Dim k As Integer
Dim i As Integer
k = 0
ReDim subPath(1) As String
Set nd = tvwFile.SelectedItem
fullPath = nd.Key
intlocal = 1
intlocal = InStr(intlocal, fullPath, "\", vbTextCompare)
Do While intlocal > 0
ReDim Preserve subPath(UBound(subPath) + 1)
subPath(k) = Left(fullPath, intlocal - 1)
k = k + 1
intlocal = intlocal + 1
intlocal = InStr(intlocal, fullPath, "\", vbTextCompare)
Loop
subPath(k) = fullPath
ImageCombo1.ComboItems.Clear
Set nd = tvwFile.Nodes("desktop")
Set cmbitem = ImageCombo1.ComboItems.Add(1, nd.Key, nd.Text, nd.Image, , 0)
cmbitem.Tag = nd.Tag
Set nd = tvwFile.Nodes("mycomp")
Set cmbitem = ImageCombo1.ComboItems.Add(2, nd.Key, nd.Text, nd.Image, , 1)
cmbitem.Tag = nd.Tag
i = 3
'決定順序
For Each drv In fso.Drives
Set cmbitem = ImageCombo1.ComboItems.Add(i, drv.DriveLetter + ":\", drv.DriveLetter, , , 2)
cmbitem.Image = tvwFile.Nodes(drv.path + "\").Image
cmbitem.Tag = tvwFile.Nodes(drv.path + "\").Tag
i = i + 1
If drv.path = subPath(0) Then
For intlocal = 1 To k
If subPath(intlocal) <> drv.path + "\" Then
Set nd = tvwFile.Nodes(subPath(intlocal))
Set cmbitem = ImageCombo1.ComboItems.Add(i, nd.Key, nd.Text, nd.Image, , 2 + intlocal)
cmbitem.Tag = nd.Tag
i = i + 1
End If
Next
End If
Next
ImageCombo1.ComboItems(fullPath).Selected = True
End Sub
Private Sub lvwFile_AfterLabelEdit(Cancel As Integer, NewString As String)
Dim strPath As String
Dim strName As String
Dim bOk As Boolean
'檢查是否為空
bOk = False
NewString = Trim(NewString)
If Len(NewString) <> 0 Then
If lvwFile.SelectedItem.Tag = 0 Then '若是驅動器
Cancel = True '取消
ElseIf lvwFile.SelectedItem.Tag = 1 Then '若是文件夾
strPath = lvwFile.SelectedItem.Key
strName = lvwFile.SelectedItem.Text
If StrComp(UCase(strName), UCase(NewString)) <> 0 Then
strPath = Left(strPath, Len(strPath) - Len(strName)) + NewString
If fso.FolderExists(strPath) Then
MsgBox "此文件夾已存在！", vbOKCancel + vbCritical, "警告"
Cancel = True
Else
bOk = True
fso.GetFolder(lvwFile.SelectedItem.Key).Name = NewString
'注意這個順序，不可以互換
tvwFile.Nodes(lvwFile.SelectedItem.Key).Text = NewString
tvwFile.Nodes(lvwFile.SelectedItem.Key).Key = strPath
lvwFile.SelectedItem.Key = strPath
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -