⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 iso文件制作与制作光盘 iso文件制作与制作光盘
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    ' 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 + -