media.frm

两个VB播放器 两个VB播放器 两个VB播放器 两个VB播放器

Sub addrnode(smanagern As String, int_1 As Integer)
    Dim ndnewnode As Node
    Set ndnewnode = TreeView1.Nodes.Add(, , smanagern, smanagern, int_1)   '//添加父结点
End Sub

Sub addnode(strteammname As String, smanagern As String, int_2 As Integer)            '//添加子结点
  Dim ndnewnode As Node
  Set ndnewnode = TreeView1.Nodes.Add(smanagern, tvwChild, strteammname, strteammname, int_2)
End Sub



Private Sub cmdAddFile_Click()
 On Error GoTo label
 If TreeView1.SelectedItem <> "" Then
   Dialog8.Show
 End If
   Exit Sub
label:   MsgBox "请先选中一个结点", vbExclamation + vbOKOnly, "警告"
End Sub

Private Sub cmdAddNode_Click()
   'On Error Resume Next
   Dim ndtemp As Node
   Dim strmname As String                                         '//添加新结点
   On Error GoTo errhandler
   strmname = InputBox("请输入新结点名", "添加结点", "新建结点")
   If strmname = "" Then Exit Sub
   Set ndtemp = TreeView1.Nodes.Add(TreeView1.SelectedItem.Text, tvwChild, strmname, strmname, 15)
   Form6.TreeView1.SelectedItem.Expanded = True
   Exit Sub
errhandler:
     Resume exitlabel
exitlabel:
End Sub

Private Sub cmdDel_Click()
    On Error GoTo label
   Dim Dir1 As String
   TreeView1.Nodes.Remove TreeView1.SelectedItem.Key
   Dir1 = Dir(App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u")
   If Dir1 <> "" Then
      Kill App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u"
   End If
   Exit Sub
label:    MsgBox "请先选中一个结点", vbExclamation + vbOKOnly, "警告"
End Sub

Private Sub cmdEdite_Click()
 On Error GoTo label
 Dim dir_1
 dir_1 = Dir(App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u")
  If TreeView1.SelectedItem <> "" And dir_1 <> "" Then
   Dialog7.Show
  End If
   Exit Sub
label:   MsgBox "请先选中一个结点", vbExclamation + vbOKOnly, "警告"
End Sub

Private Sub cmdExit_Click()
   Dim ndsample As Node
   Dim retval As Integer                                 '//保存结点内容
   Dim strfilen As String
   strfilen = App.Path & "\temp\Save_Nodes.nod"
   savefile strfilen
  Unload Form6
  Set Form6 = Nothing
End Sub

Private Sub cmdNewName_Click()
  On Error GoTo label
  Dim dir_1 As String
  Dim strNewName As String
  dir_1 = Dir(TreeView1.SelectedItem)
  If dir_1 <> "" Then
    MsgBox "此结点不可重命名", vbOKOnly + vbExclamation, "提示"
  Else
    strNewName = InputBox("请输入新的结点名", "重命名", TreeView1.SelectedItem.Text)
    If strNewName = "" Then
        Exit Sub
    Else
        Name App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u" As App.Path & "\temp\" & strNewName & ".m3u"
        TreeView1.SelectedItem.Text = strNewName
        
    End If
  End If
  Exit Sub
label: MsgBox "请先选中一个结点", vbExclamation + vbOKOnly, "警告"
 
End Sub

Private Sub cmdPlay_Click()
  On Error Resume Next
  Dim index As Integer
  Dim i As Integer
 
If List1.List(0) <> "" Then
   For i = 0 To 50
     Form1.meu(i).Checked = False
     Unload Form1.meu(i)
   Next
 If List1.SelCount <> 0 Then
   i = 0
   For index = 0 To List1.ListCount - 1
     If List1.Selected(index) Then
         i = i + 1
         With Form1.MMControl1
            .Command = "Stop"
            .Command = "Close"
         Form1.meuPlayFile.Visible = True
         Form1.meuPlayList.Visible = False
         Form1.meuMusic.Visible = False
         Form1.meuCDQuMu.Visible = False
         Load Form1.meu(i)
         Form1.meu(i).Caption = List1.List(index)
         Debug.Print Form1.meu(i).Caption
        End With
     End If
   Next index
   Form1.Label2.Caption = "曲目总数: " & i
 Else
  For index = 0 To List1.ListCount - 1
         With Form1.MMControl1
            .Command = "Stop"
            .Command = "Close"
         Form1.meuPlayFile.Visible = True
         Form1.meuPlayList.Visible = False
         Form1.meuMusic.Visible = False
         Form1.meuCDQuMu.Visible = False
         Load Form1.meu(index + 1)
         Form1.meu(index + 1).Caption = List1.List(index)
        End With
   Next index
   Form1.Label2.Caption = "曲目总数: " & List1.ListCount
 End If
  Form1.MMControl1.FileName = Form1.meu(1).Caption
  Form1.MMControl1.Command = "Open"
  Form1.MMControl1.Command = "Play"
  Form1.MMControl1.UpdateInterval = 1000
  Form1.meu(1).Checked = True
  Unload Form6
  Set Form6 = Nothing
End If
End Sub

Private Sub Command3_Click()

End Sub

Private Sub Command1_Click()
  MCI.Command = "Pause"
End Sub

Private Sub Command2_Click()
   'Dim i As Integer
   Dim ndsample As Node
   Dim retval As Integer                                 '//保存结点内容
   Dim strfilen As String
   strfilen = App.Path & "\temp\Save_Nodes.nod"
   savefile strfilen
End Sub

Private Sub Form_Load()
  On Error Resume Next
  Dim dir_1 As String
  Dim smanagern As String
  Dim strteammname As String
  dir_1 = Dir(App.Path & "\temp\Save_Nodes.nod")
  List1.Clear
If dir_1 = "" Then
  TreeView1.Nodes.Clear
  TreeView1.Nodes.Add , , "我的媒体库", "我的媒体库", 1
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "流行歌曲", "流行歌曲", 2
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "经典歌曲", "经典歌曲", 4
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "中国器乐", "中国器乐", 12
  TreeView1.Nodes.Add "中国器乐", tvwChild, "笛子", "笛子", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "古筝", "古筝", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "古琴", "古琴", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "琵琶", "琵琶", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "葫芦丝", "葫芦丝", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "二胡", "二胡", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "唢呐", "唢呐", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "箫", "箫", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "打击乐", "打击乐", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "广东丝竹", "广东丝竹", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "吹打乐", "吹打乐", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "管子", "管子", 15
  TreeView1.Nodes.Add "中国器乐", tvwChild, "陨", "陨", 15
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "古典歌曲", "古典歌曲", 4
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "轻音乐", "轻音乐", 5
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "摇滚音乐", "摇滚音乐", 6
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "通俗音乐", "通俗音乐", 7
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "好听的音乐", "好听的音乐", 8
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "不好听的音乐", "不好听的音乐", 9
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "个人专集", "个人专集", 10
  TreeView1.Nodes.Add "个人专集", tvwChild, "刀郎", "刀郎", 15
  TreeView1.Nodes.Add "个人专集", tvwChild, "刘德华", "刘德华", 15
  TreeView1.Nodes.Add "个人专集", tvwChild, "张学友", "张学友", 15
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "戏曲", "戏曲", 11
  TreeView1.Nodes.Add "戏曲", tvwChild, "黄梅戏", "黄梅戏", 15
  TreeView1.Nodes.Add "戏曲", tvwChild, "京剧", "京剧", 15
  TreeView1.Nodes.Add "戏曲", tvwChild, "越剧", "越剧", 15
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "外国器乐", "外国器乐", 13
  TreeView1.Nodes.Add "外国器乐", tvwChild, "小提琴", "小提琴", 15
  TreeView1.Nodes.Add "外国器乐", tvwChild, "钢琴", "钢琴", 15
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "英文歌曲", "英文歌曲", 14
  TreeView1.Nodes.Add "我的媒体库", tvwChild, "我的播放列表", "我的播放列表", 16
  TreeView1.Nodes(1).Expanded = True
Else
    strfilen = App.Path & "\temp\Save_Nodes.nod"
        TreeView1.Nodes.Clear
        Open strfilen For Input As #2
           Input #2, strteammname, smanagern
           Call addrnode(strteammname, 1)
           While Not EOF(2)
             Input #2, strteammname, smanagern
             Call addnode(strteammname, smanagern, 15)
           Wend
        Close #2
    TreeView1.Nodes(1).Expanded = True
End If
     For i% = 0 To 500
        TreeView1.Nodes.Item(i).ForeColor = &HC000&
        TreeView1.Nodes.Item(i).BackColor = &H0&
     Next i
'Dim newcolor As Long
 'With cdg
  '.Flags = cdlocrgbinit
  '.Color = gettvbackcolour()
  '.ShowColor
  'newcolor = .Color
  'settvbackcolour newcolor
 'End With
'Dim newclr As Long
  'newclr = gettvforecolour()
  'settvforecolour newclr
TreeView1.LabelEdit = tvwManual
MCI.Wait = True
MCI.Notify = False
MCI.Shareable = False
MCI.DeviceType = "MPEGVideo"
End Sub



Private Sub Form_Unload(Cancel As Integer)
   'Dim i As Integer
   Dim ndsample As Node
   Dim retval As Integer                                 '//保存结点内容
   Dim strfilen As String
   Close #1, #2, #3, #4, #5
   strfilen = App.Path & "\temp\Save_Nodes.nod"
   savefile strfilen
   MCI.Command = "Stop"
   MCI.Command = "Close"
   Set Form6 = Nothing
End Sub

Private Sub List1_DblClick()
  MCI.Command = "Stop"
  MCI.Command = "Close"
  MCI.FileName = List1.Text
  MCI.Command = "Open"
  MCI.Command = "Play"
  MCI.UpdateInterval = 1000
  Label10.Caption = "正在播放： " & MCI.FileName
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
    If Shift = 2 And KeyCode = vbKeyA Then
     For index = 0 To List1.ListCount - 1
         List1.Selected(index) = True
     Next index
  End If
End Sub

Private Sub MCI_StatusUpdate()
  Dim j As Long
  On Error Resume Next
   Slider1.Min = 0
   MCI.UpdateInterval = 1000
   j = MCI.Length / 1000               '曲目总长
   Slider1.Max = j
   Slider1.Value = MCI.Position / 1000        '当前曲目播放了的长度
   If MCI.Mode = 525 Then
     Slider1.Enabled = False
     Slider1.Value = 0
   End If
End Sub


Private Sub Slider1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  On Error Resume Next
   MCI.From = Slider1.Value * 1000     ' 实现重复播放
   MCI.Command = "Play"
End Sub

Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
   On Error Resume Next
   For i% = 0 To 500
        TreeView1.Nodes.Item(i).ForeColor = &HC000&
        TreeView1.Nodes.Item(i).BackColor = &H0&
   Next i
   
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  On Error Resume Next
  Dim dir_2 As String
  Dim nextline As String
  Static My_Expend As Boolean
  My_Expend = Not My_Expend
  dir_2 = Dir(App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u")
  If dir_2 <> "" Then
    If FileLen(App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u") <> 0 Then
     Open App.Path & "\temp\" & TreeView1.SelectedItem.Text & ".m3u" For Input As #3
         List1.Clear
         Do While Not EOF(3)
            Line Input #3, nextline
            List1.AddItem nextline
         Loop
     Close #3
     For i% = 0 To 500
        TreeView1.Nodes.Item(i).ForeColor = &HC000&
        TreeView1.Nodes.Item(i).BackColor = &H0&
     Next i
     MCI.Command = "Stop"
     MCI.Command = "Close"
     MCI.FileName = List1.Text
     MCI.Command = "Open"
     MCI.Command = "Play"
     MCI.UpdateInterval = 1000
     Label10.Caption = "正在播放： " & MCI.FileName
    End If
  End If
 If My_Expend = True Then
    TreeView1.SelectedItem.Expanded = True
 Else
    TreeView1.SelectedItem.Expanded = False
 End If
End Sub