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

📄 mainform.frm

📁 光盘管家
💻 FRM
📖 第 1 页 / 共 3 页
字号:
   End If
End If
Load Find
Find.Show vbModal
WriteToDisk
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMouseDown = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bMouseDown Then
   Me.Picture1.Move Me.Picture1.Left + X
End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMouseDown = False
If Me.Picture1.Left < 1500 Then
   Me.Picture1.Left = 1500
End If
If Me.Picture1.Left > Me.Width - 1680 Then
   Me.Picture1.Left = Me.Width - 1680
End If
TreeView1.Width = Me.Picture1.Left
TreeView2.Left = Picture1.Left + Picture1.Width
Label1.Left = TreeView2.Left
Label2.Left = Label1.Left
RichTextBox1.Left = Label1.Left
TreeView2.Width = Me.Width - TreeView1.Left - TreeView1.Width - Picture1.Width - 180
RichTextBox1.Width = TreeView2.Width
End Sub

Private Sub richtextbox1_LostFocus()
If RichTextBox1.Text <> CdromText Then
   If RichTextBox1.Locked = False Then
      If vbNo = MsgBox("描述文本已修改,是否保存新描述文本!", vbQuestion + vbYesNo) Then
         RichTextBox1.Text = CdromText
      End If
      RichTextBox1.Locked = True
      RichTextBox1.SaveFile TreeView1.SelectedItem.Text + ".mx"
   End If
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
       Case "backup"
           Load Backup2
           Backup2.Show vbModal
       Case "restore"
              Load Restore
              Restore.Show vbModal
       Case "add"
           mnuAddCdrom_Click
       Case "help"
           Load frmAbout
           frmAbout.Show vbModal
       Case "find"
           If TreeView1.SelectedItem.Text = "光盘库" Then
              havecdrom = False
              Dim nodddx As Node
              Set nodddx = TreeView1.SelectedItem.Child
              For i = 1 To TreeView1.SelectedItem.Children
                  If nodddx.Children Then
                     havecdrom = True
                     Exit For
                  End If
                  Set nodddx = nodddx.Next
              Next
              If havecdrom Then
                 CdromName = "光盘库"
                 Info = "整个光盘库"
              Else
                 MsgBox "整个光盘库中没有光盘,用不着查找!", vbInformation
                 Exit Sub
              End If
           Else
              If TreeView1.SelectedItem.Parent.Text = "光盘库" Then
                 If TreeView1.SelectedItem.Children < 1 Then
                    MsgBox "类别(" + TreeView1.SelectedItem.Text + ")中没有光盘,用不着查找!", vbInformation
                    Exit Sub
                 End If
                 CdromName = TreeView1.SelectedItem.Text
                 Info = "类别 (" + TreeView1.SelectedItem.Text + ")"
              Else
                 CdromName = TreeView1.SelectedItem.Text
                 Info = "(" + TreeView1.SelectedItem.Parent.Text + ") " + TreeView1.SelectedItem.Text
              End If
          End If
          Load Find
          Find.Show vbModal
          WriteToDisk
End Select
End Sub
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
 If TreeView1.SelectedItem.Key = "@@@@@***##查找结果@@@@@***##" Then
    mnuFindResultDelete.Caption = "删除 查找结果"
    PopupMenu mnuFindResult
    Exit Sub
 End If
 If Left(TreeView1.SelectedItem.Key, 24) = "@@@@@***##查找结果@@@@@***##" And Len(TreeView1.SelectedItem.Key) > 24 Then
    mnuFindResultDelete.Caption = "删除光盘 " + TreeView1.SelectedItem.Text + " 的查找结果"
    PopupMenu mnuFindResult
 Else
   If TreeView1.SelectedItem.Key = "光盘库" Then
      mnuDeleteStyle.Enabled = False
      mnuRenameStyle.Enabled = False
      PopupMenu mnuStyleRightButtonMenu
      Exit Sub
   End If
   If TreeView1.SelectedItem.Parent.Key = "光盘库" Then
      mnuDeleteStyle.Enabled = True
      mnuRenameStyle.Enabled = True
      PopupMenu mnuStyleRightButtonMenu
   Else
      PopupMenu mnuCdromRightButtonMenu
   End If
 End If
End If
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
'单击查找结果
If Node.Key = "@@@@@***##查找结果@@@@@***##" Then
   Label1.Caption = "查找结果"
   Node.Expanded = True
   TreeView2.Nodes.Clear
   Toolbar1.Buttons("find").Enabled = False
   RichTextBox1.Text = "请选择一个光盘看查找结果"
   Exit Sub
End If
'单击查找结果的某一张光盘
If Left(Node.Key, 24) = "@@@@@***##查找结果@@@@@***##" Then
   Toolbar1.Buttons("find").Enabled = False
   nodetext = Node.Text + ".fnd"
   If Dir(nodetext) = "" Then
      MsgBox "光盘 " + Chr(34) + Node.Text + Chr(34) + " 查找结果文件丢失,请重新生成!", vbCritical
      For i = 2 To TreeView1.Nodes.Count
          If TreeView1.Nodes.Item(i).Key = TreeView1.SelectedItem.Key Then
             Exit For
          End If
      Next
      RichTextBox1.Text = ""
      TreeView1.Nodes.Remove i
      TreeView2.Nodes.Clear
      WriteToDisk
      Exit Sub
   Else
      Dim FileNotes As String
      fnum = FreeFile
      Open nodetext For Input As #fnum
         Line Input #fnum, FileNotes
         sFindString = FileNotes
         Label1.Caption = "正在读取光盘 (" + TreeView1.SelectedItem.Text + ")" + " 查找 " + Chr(34) + sFindString + Chr(34) + " 后的结果镜像文件..."
         Me.MousePointer = 11
         TreeView2.Nodes.Clear
         Line Input #fnum, FileNotes
         TreeView2.Nodes.Add , , FileNotes, FileNotes, 1
            '把文件写入NODES中
            Do While Not EOF(fnum)
            Line Input #fnum, FileNotes
            If Right(FileNotes, 1) = "\" Then
               fns1 = Left(FileNotes, Len(FileNotes) - 1)
               For i = Len(fns1) To 1 Step -1
                   If Mid(fns1, i, 1) = "\" Then
                      FnsPath = Left(fns1, i)
                      FnsName = Mid(fns1, i + 1)
                      Exit For
                   End If
               Next
               TreeView2.Nodes.Add FnsPath, tvwChild, FileNotes, FnsName, 3, 2
            Else
               For i = Len(FileNotes) To 1 Step -1
                   If Mid(FileNotes, i, 1) = "\" Then
                      FnsPath = Left(FileNotes, i)
                      FnsName = Mid(FileNotes, i + 1)
                      Exit For
                   End If
               Next
               TreeView2.Nodes.Add FnsPath, tvwChild, FileNotes, FnsName, 10
            End If
         Loop
         Close fnum
         RichTextBox1.Text = ""
         TreeView2.Nodes(1).Expanded = True
         Label1.Caption = "光盘 (" + TreeView1.SelectedItem.Text + ")" + " 查找 " + Chr(34) + sFindString + Chr(34) + " 后的结果"
         RichTextBox1.Text = Label1.Caption
         Me.MousePointer = 0
         Exit Sub
      End If
   End If

'单击光盘库
If Node.Text = "光盘库" Then
   Toolbar1.Buttons("find").Enabled = True
   TreeView2.Nodes.Clear
   Node.Expanded = True
   Label1.Caption = "整个光盘库"
   RichTextBox1.Text = "感谢使用 忠霖软件创作室 的产品"
   TreeView2.Nodes.Clear
   Exit Sub
End If
'单击了类别
If Node.Parent.Text = "光盘库" Then
   Toolbar1.Buttons("find").Enabled = True
   Label1.Caption = "类别(" + Node.Text + ")"
   RichTextBox1.Text = "感谢使用 忠霖软件创作室 的产品"
   TreeView2.Nodes.Clear
   Exit Sub
Else
  Toolbar1.Buttons("find").Enabled = True
   nodetext = Node.Text + ".cdo"
   If Dir(nodetext) = "" Then
      MsgBox "光盘 " + Chr(34) + Node.Text + Chr(34) + " 镜像文件丢失,请重新生成!", vbCritical
      DeleteCdrom
      Exit Sub
   Else
      fnum = FreeFile
      Open nodetext For Input As #fnum
      Line Input #fnum, FileNotes
      If FileNotes <> "@@@@@***##光盘镜像文件@@@@@***##" Then
         MsgBox "非法的光盘镜像文件 " + Chr(34) + Node.Text + Chr(34) + Chr(13) + Chr(13) + "请重新生成光盘镜像文件!", vbCritical
         DeleteCdrom
         Exit Sub
      Else
         Label1.Caption = "正在读取光盘 " + Chr(34) + Node.Text + Chr(34) + " 的镜像文件......"
         Me.Refresh
         Me.MousePointer = 11
         TreeView2.Nodes.Clear
         Line Input #fnum, FileNotes
         TreeView2.Nodes.Add , , FileNotes, FileNotes, 1
            Do While Not EOF(fnum)
            Line Input #fnum, FileNotes
            If Right(FileNotes, 1) = "\" Then
               fns1 = Left(FileNotes, Len(FileNotes) - 1)
               For i = Len(fns1) To 1 Step -1
                   If Mid(fns1, i, 1) = "\" Then
                      FnsPath = Left(fns1, i)
                      FnsName = Mid(fns1, i + 1)
                      Exit For
                   End If
               Next
               TreeView2.Nodes.Add FnsPath, tvwChild, FileNotes, FnsName, 3, 2
            Else
               For i = Len(FileNotes) To 1 Step -1
                   If Mid(FileNotes, i, 1) = "\" Then
                      FnsPath = Left(FileNotes, i)
                      FnsName = Mid(FileNotes, i + 1)
                      Exit For
                   End If
               Next
               TreeView2.Nodes.Add FnsPath, tvwChild, FileNotes, FnsName, 10
            End If
         Loop
         Close fnum
         RichTextBox1.Text = ""
         If Left(Node.Key, 24) <> "@@@@@***##查找结果@@@@@***##" Then
         If Dir(Node.Text + ".mx") <> "" Then
            RichTextBox1.LoadFile Node.Text + ".mx"
         End If
         End If
         TreeView2.Nodes(1).Expanded = True
         Label1.Caption = TreeView1.SelectedItem.Parent.Text + "  (" + TreeView1.SelectedItem.Text + ")  中的文件夹与文件"
         Me.MousePointer = 0
      End If
   End If
End If
End Sub


Public Sub WriteToDisk()
  Close
  fnum = FreeFile
  Open "cdrom.cds" For Output As #fnum
  For i = 2 To TreeView1.Nodes.Count
    Print #fnum, TreeView1.Nodes.Item(i).Key
  Next
  Close fnum
End Sub

Public Sub DeleteCdrom()
      For i = 2 To TreeView1.Nodes.Count
          If TreeView1.Nodes.Item(i).Key = TreeView1.SelectedItem.Key Then
             Exit For
          End If
      Next
      RichTextBox1.Text = ""
      If Dir(TreeView1.Nodes(i).Text + ".cdo") <> "" Then
         Kill TreeView1.Nodes(i).Text + ".cdo"
      End If
      If Dir(TreeView1.Nodes(i).Text + ".mx") <> "" Then
         Kill TreeView1.Nodes(i).Text + ".mx"
      End If
      TreeView1.Nodes.Remove i
      TreeView2.Nodes.Clear
      WriteToDisk
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -