📄 frmmain.frm
字号:
' find the index of the directory to remove
For i = 0 To clsDir.Parent.SubDirectoryCount - 1
If clsDir Is clsDir.Parent.SubDirectory(i) Then
clsDir.Parent.RemoveSubDirectory i
Exit For
End If
Next
' remove the directory from the treeview
tvwDirs.DeleteNode tvwDirs.SelectedNode
End Sub
Private Sub mnuDirRen_Click()
tvwDirs.StartLabelEdit tvwDirs.SelectedNode
End Sub
Private Sub mnuFileRen_Click()
lvwFiles.StartLabelEdit
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuFilesRem_Click()
Dim i As Long
Dim clsDir As clsISODirectory
Set clsDir = DirFromSelectedNode()
If clsDir Is Nothing Then Exit Sub
' The index of an item in the Listview should
' be equal to (Index - 1) in a files collection.
' So don't sort the Listview!
With lvwFiles.ListItems
For i = .Count To 1 Step -1
If .Item(i).Selected Then
clsDir.Files.Remove i - 1
.Remove i
End If
Next
End With
End Sub
Private Sub mnuISOCreate_Click()
With dlg
.FileName = vbNullString
.ShowSave
End With
If dlg.FileName = vbNullString Then Exit Sub
If Not clsISOWrt.SaveISO(dlg.FileName) Then
MsgBox "Failed!", vbExclamation
End If
End Sub
Private Sub mnuPrjClear_Click()
Set clsISOWrt = New clsISOWriter
With tvwDirs
.Clear
.AddNode Key:="\", _
text:="root", _
Image:=0, _
SelectedImage:=0
.SelectedNode = .GetKeyNode("\")
End With
lvwFiles.ListItems.Clear
End Sub
Private Sub picHeader_Resize()
On Error Resume Next
lnDiv.x1 = 0
lnDiv.x2 = picHeader.ScaleWidth
lnDiv2.x1 = lnDiv.x1
lnDiv2.x2 = lnDiv.x2
End Sub
Private Sub tabstrip_Click()
Select Case tabstrip.SelectedItem.Key
Case "FS"
spltMain.Visible = True
picVD.Visible = False
Case "VD"
spltMain.Visible = False
picVD.Visible = True
End Select
End Sub
Private Sub timeCreation_Change()
With dateCreation
clsISOWrt.VolumeCreation = .Day & "." & .Month & "." & .Year & " " & _
timeCreation.Hour & ":" & timeCreation.Minute & ":" & timeCreation.Second
End With
End Sub
Private Sub tvwDirs_AfterLabelEdit( _
ByVal hNode As Long, _
Cancel As Integer, _
NewString As String _
)
Dim clsDir As clsISODirectory
Dim strOldName As String
Set clsDir = clsISOWrt.DirByPath(tvwDirs.GetNodeKey(hNode))
If clsDir Is Nothing Then
Cancel = 1
Exit Sub
End If
If Trim$(NewString) = "" Then
Cancel = 1
Exit Sub
End If
clsDir.name = NewString
' The key of a node is the full path from the root to the node.
' When the node's text gets changed, the key doesn't change.
' Consequence is, you can't find the directory in the image
' no more. So just rebuild the tree.
ISOBuildTree tvwDirs.NodeParent(hNode), clsDir.Parent
End Sub
Private Sub tvwDirs_BeforeLabelEdit( _
ByVal hNode As Long, _
Cancel As Integer _
)
' You can not rename the root
If hNode = tvwDirs.GetKeyNode("\") Then Cancel = 1
End Sub
Private Sub tvwDirs_MouseDown( _
Button As Integer, _
Shift As Integer, _
x As Long, _
y As Long _
)
Dim hNode As Long
If Button = vbRightButton Then
' make sure the node under the mouse cursor
' shows up selected
hNode = tvwDirs.HitTest(x, y, False)
If hNode Then tvwDirs.SelectedNode = hNode
PopupMenu mnuMenuDir, _
vbPopupMenuRightButton, _
DefaultMenu:=mnuDirNew
End If
End Sub
Private Function GetFilename( _
ByVal path As String _
) As String
GetFilename = Mid$(path, InStrRev(path, "\") + 1)
End Function
Private Function FileExists( _
ByVal path As String _
) As Boolean
On Error Resume Next
FileExists = (GetAttr(path) And (vbDirectory Or vbVolume)) = 0
End Function
Private Function DirExists( _
ByVal path As String _
) As Boolean
On Error Resume Next
DirExists = CBool(GetAttr(path) And vbDirectory)
End Function
Private Sub tvwDirs_MouseUp( _
Button As Integer, _
Shift As Integer, _
x As Long, _
y As Long _
)
' on left button click show files associated with the
' node under the mouse cursor
If Button = 1 Then
ShowFilesForDir tvwDirs.HitTest(x, y, False)
End If
End Sub
Private Sub ShowFilesForDir( _
ByVal hNode As Long _
)
Dim clsDir As clsISODirectory
Dim i As Long
' clsISODirectory by node
Set clsDir = clsISOWrt.DirByPath(tvwDirs.GetNodeKey(hNode))
If clsDir Is Nothing Then Exit Sub
lvwFiles.ListItems.Clear
' show file's name and size
For i = 0 To clsDir.Files.Count - 1
With lvwFiles.ListItems.Add(text:=clsDir.Files.File(i).name, SmallIcon:=2)
.SubItems(1) = FormatFileSize(clsDir.Files.File(i).Size)
End With
Next
End Sub
Private Sub tvwDirs_OLEDragDrop( _
Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
x As Single, _
y As Single _
)
Dim i As Long
Dim hNode As Long
Dim hNodeSrc As Long
Dim clsDir As clsISODirectory
Dim clsDirDst As clsISODirectory
Dim strFilter() As String
Dim blnNewDirs As Boolean
ReDim strFilter(0) As String
strFilter(0) = "*"
' data dropped from the listview?
If Data.GetFormat(OLEDragDropFormatLVW) Then
' get the target node
tvwDirs.OLEGetDropInfo hNode, True
If hNode = 0 Then Exit Sub
' the dropped files have to be in the currently selected directory
Set clsDir = DirFromSelectedNode()
If clsDir Is Nothing Then Exit Sub
' target directory to move the files to
Set clsDirDst = clsISOWrt.DirByPath(tvwDirs.GetNodeKey(hNode))
If clsDirDst Is Nothing Then Exit Sub
' target and source are the same, cancel
If hNode = tvwDirs.SelectedNode Then Exit Sub
' move the files to the target directory
For i = lvwFiles.ListItems.Count To 1 Step -1
If lvwFiles.ListItems(i).Selected Then
With clsDir.Files.File(i - 1)
clsDirDst.Files.Add .LocalPath, .name
End With
lvwFiles.ListItems.Remove i
clsDir.Files.Remove i - 1
End If
Next
' refresh Listview
ShowFilesForDir tvwDirs.SelectedNode
Exit Sub
End If
' files/directories dropped from the Explorer (or something like that)
If Data.GetFormat(vbCFFiles) Then
tvwDirs.OLEGetDropInfo hNode, True
If hNode = 0 Then Exit Sub
Set clsDir = clsISOWrt.DirByPath(tvwDirs.GetNodeKey(hNode))
If clsDir Is Nothing Then Exit Sub
For i = 1 To Data.Files.Count
If DirExists(Data.Files(i)) Then
' add directories + subdirectories
With clsDir.AddSubDirectory(GetFilename(Data.Files(i)))
.AddLocalDirectory Data.Files(i), strFilter
End With
blnNewDirs = True
Else
' must be a file
clsDir.Files.Add Data.Files(i)
End If
Next
If blnNewDirs Then
tvwDirs.SetRedrawMode False
ISOBuildTree hNode, clsDir
tvwDirs.SetRedrawMode True
End If
ShowFilesForDir tvwDirs.SelectedNode
sbar.Panels(2).text = FormatFileSize(clsISOWrt.ImageSize)
Exit Sub
End If
' node moved
If tvwDirs.OLEIsMyFormat(Data) Then
' Sourcenode
tvwDirs.OLEGetDragInfo Data, 0, hNodeSrc
' Targetnode
tvwDirs.OLEGetDropInfo hNode, True
' nodes may not move to the the nirvana
If hNodeSrc = 0 Or hNode = 0 Then Exit Sub
Set clsDir = clsISOWrt.DirByPath(tvwDirs.GetNodeKey(hNodeSrc))
If clsDir Is Nothing Then Exit Sub
Set clsDirDst = clsISOWrt.DirByPath(tvwDirs.GetNodeKey(hNode))
If clsDirDst Is Nothing Then Exit Sub
' source may not be the target
If clsDir Is clsDirDst Then Exit Sub
' source may not be dropped on its parent
If clsDir.Parent Is clsDirDst Then Exit Sub
' source may not be dropped on one of its childs
If clsISOWrt.DirectoryIsChildOf(clsDir, clsDirDst) Then Exit Sub
' find source and remove it from its parent
For i = 0 To clsDir.Parent.SubDirectoryCount - 1
If clsDir.Parent.SubDirectory(i) Is clsDir Then
' the second parameter is only for cases like this one,
' in wich the directory shall be moved!
' True causes RemoveSubDirectory to only remove
' the directory, but not its subdirectories,
' else the moved directory would be empty.
clsDir.Parent.RemoveSubDirectory i, True
Exit For
End If
Next
clsDirDst.AddSubDirectoryByRef clsDir
tvwDirs.DeleteNode hNodeSrc
ISOBuildTree hNode, clsDirDst
ShowFilesForDir tvwDirs.SelectedNode
End If
End Sub
Private Sub tvwDirs_OLEStartDrag( _
Data As DataObject, _
AllowedEffects As Long _
)
Dim clsDir As clsISODirectory
Set clsDir = DirFromSelectedNode()
If clsDir Is Nothing Then Exit Sub
' root not movable
If clsDir.FullPath = "\" Then Exit Sub
AllowedEffects = vbDropEffectMove
End Sub
Private Sub txtAppID_LostFocus()
Dim blnJoliet As Boolean
blnJoliet = cboDescr.ListIndex = 1
clsISOWrt.ApplicationID(blnJoliet) = txtAppID.text
txtAppID.text = clsISOWrt.ApplicationID(blnJoliet)
End Sub
Private Sub txtPrepID_LostFocus()
Dim blnJoliet As Boolean
blnJoliet = cboDescr.ListIndex = 1
clsISOWrt.DataPreparerID(blnJoliet) = txtPrepID.text
txtPrepID.text = clsISOWrt.DataPreparerID(blnJoliet)
End Sub
Private Sub txtPubID_LostFocus()
Dim blnJoliet As Boolean
blnJoliet = cboDescr.ListIndex = 1
clsISOWrt.PublisherID(blnJoliet) = txtPubID.text
txtPubID.text = clsISOWrt.PublisherID(blnJoliet)
End Sub
Private Sub txtSysID_LostFocus()
Dim blnJoliet As Boolean
blnJoliet = cboDescr.ListIndex = 1
clsISOWrt.SystemID(blnJoliet) = txtSysID.text
txtSysID.text = clsISOWrt.SystemID(blnJoliet)
End Sub
Private Sub txtVolID_LostFocus()
Dim blnJoliet As Boolean
blnJoliet = cboDescr.ListIndex = 1
clsISOWrt.VolumeID(blnJoliet) = txtVolID.text
txtVolID.text = clsISOWrt.VolumeID(blnJoliet)
End Sub
Private Sub txtVolSetID_LostFocus()
Dim blnJoliet As Boolean
blnJoliet = cboDescr.ListIndex = 1
clsISOWrt.VolumeSetID(blnJoliet) = txtVolSetID.text
txtVolSetID.text = clsISOWrt.VolumeSetID(blnJoliet)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -