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

📄 frmplayer.vb

📁 这是一本用Visual Studio.NET进行多媒体编程的读物
💻 VB
📖 第 1 页 / 共 2 页
字号:
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	Dim Fso As Scripting.FileSystemObject = New Scripting.FileSystemObject
    'Dim Player As MediaPlayer.MediaPlayer = New MediaPlayer.MediaPlayer
	
	Dim strDrive As String '当前的驱动器标号
	
	Dim strFolder As String '当前的文件夹路径
	
	Dim Col As Collection = New Collection '存放当前文件夹下的所有文件的集合
	Dim Playing As Short
	Dim Volume As Short
	
	Private Sub cmbDrives_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmbDrives.SelectedIndexChanged
		Dim drive As Scripting.Drive
		Dim File As Scripting.File
		Dim SubFolder As Scripting.Folder
		Dim i As Short
		i = 0
		lstFiles.Items.Clear()
		If cmbDrives.Text = "" Then Exit Sub
		strDrive = cmbDrives.Text
		strFolder = ""
		drive = Fso.GetDrive(cmbDrives.Text)
		If drive.IsReady Then
			For	Each File In drive.RootFolder.Files
				If InStr(File.Path, "mp3") Then
					lstFiles.Items.Insert(i, File.Name)
					i = i + 1
				End If
				
			Next File
			i = lstFiles.Items.Count
			For	Each SubFolder In drive.RootFolder.SubFolders
				lstFiles.Items.Insert(i, SubFolder.Path)
				i = i + 1
			Next SubFolder
		Else
			MsgBox("Drives not ready")
		End If
	End Sub
	
	Private Sub cmdAdd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdAdd.Click
		'向列表框和集合中添加元素
		Dim i As Short
		Dim J As Short
		If Col.Count() > 0 Then i = Col.Count()
		If InStr(lstFiles.Text, ":\") Then Exit Sub
		For J = 0 To lstFiles.Items.Count - 1
			If lstFiles.GetSelected(J) Then
				Col.Add(strDrive & strFolder & "\" & VB6.GetItemString(lstFiles, J), CStr(i))
				lstSelected.Items.Insert(i, VB6.GetItemString(lstFiles, J))
				i = i + 1
			End If
		Next J
	End Sub
	
	Private Sub cmdBack_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdBack.Click
		'播放前一首歌曲
		If Col.Count() = 0 Then Exit Sub

        Player.Stop()
		If Playing <> 1 Then Playing = Playing - 1

        Player.Open(Col.Item(Playing))

        Timer1.Enabled = True

        txtSong.Text = VB.Right(Col.Item(Playing), Len(Col.Item(Playing)) - InStrRev(Col.Item(Playing), "\", , CompareMethod.Text))
		Me.Text = "Player - " & txtSong.Text
	End Sub
	
	Private Sub cmdClear_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdClear.Click
		'清除集合和列表框中的元素
		Dim i As Short
		i = Col.Count()
		While i > 0
			Col.Remove(i)
			i = i - 1
		End While
		lstSelected.Items.Clear()
	End Sub
	
	Private Sub cmdNext_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdNext.Click
		'播放集合中的下一首歌曲

        Player.Stop()
		If Col.Count() = 0 Then Exit Sub
		If Playing < Col.Count() Then Playing = Playing + 1

        Player.Open(Col.Item(Playing))
		Timer1.Enabled = True

        txtSong.Text = VB.Right(Col.Item(Playing), Len(Col.Item(Playing)) - InStrRev(Col.Item(Playing), "\", , CompareMethod.Text))
		Me.Text = "Player - " & txtSong.Text
	End Sub
	
	Private Sub cmdPlay_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdPlay.Click
		Playing = 1

        If Player.PlayState = MediaPlayer.MPPlayStateConstants.mpPaused Then

            Player.Play()
        Else
            If Col.Count() = 0 Then Exit Sub

            Player.Open(Col.Item(Playing))
        End If
        Timer1.Enabled = True

        txtSong.Text = VB.Right(Col.Item(Playing), Len(Col.Item(Playing)) - InStrRev(Col.Item(Playing), "\", , CompareMethod.Text))
        Me.Text = "Player - " & txtSong.Text
        Locking(False)
	End Sub
	Private Sub Locking(ByRef State As Boolean)
		cmdAdd.Enabled = State
		cmdRemove.Enabled = State
		cmdClear.Enabled = State
	End Sub
	
	Private Sub cmdRemove_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdRemove.Click
		Dim i As Short
		If lstSelected.SelectedItems.Count > 0 Then
            lstSelected.Items.Remove(lstSelected.SelectedItem)
        End If
    End Sub

    Private Sub cmdStop_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdStop.Click
        Timer1.Enabled = False
        Player.Stop()
        Playing = 0
        Locking(True)
        txtSong.Text = ""
        Me.Text = "MP3Player"
    End Sub

    Private Sub cmdup_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdUp.Click
        '移动到上一级目录
        Dim Folder As Scripting.Folder
        Dim File As Scripting.File
        Dim SubFolder As Scripting.Folder
        Dim i As Short
        If strDrive = "" Then Exit Sub
        Folder = Fso.GetFolder(strDrive & strFolder)
        strFolder = VB.Left(strFolder, InStr(strFolder, "\"))
        lstFiles.Items.Clear()
        If Not Folder.ParentFolder Is Nothing Then
            For Each File In Folder.ParentFolder.Files
                If InStr(File.Path, "mp3") Then
                    lstFiles.Items.Insert(i, File.Name)
                    i = i + 1
                End If
            Next File

            i = lstFiles.Items.Count
            For Each SubFolder In Folder.ParentFolder.SubFolders
                lstFiles.Items.Insert(i, SubFolder.Path)
                i = i + 1
            Next SubFolder
        Else
            For Each File In Folder.Files
                If InStr(File.Path, "mp3") Then
                    lstFiles.Items.Insert(i, File.Name)
                    i = i + 1
                End If

            Next File
            i = lstFiles.Items.Count
            For Each SubFolder In Folder.SubFolders
                lstFiles.Items.Insert(i, SubFolder.Path)
                i = i + 1
            Next SubFolder
        End If
    End Sub

    Private Sub cmdPause_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdPause.Click
        If Col.Count() = 0 Then Exit Sub
        'if its paused
        If Player.PlayState = MediaPlayer.MPPlayStateConstants.mpPaused Then
            Player.Play()
            Timer1.Enabled = True
        Else
            Player.Pause()
            Timer1.Enabled = False
        End If
    End Sub

    Private Sub frmPlayer_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        Dim drive As Scripting.Drive
        Dim i As Short
        i = 0
        Me.Height = VB6.TwipsToPixelsY(2300)
        Me.Width = VB6.TwipsToPixelsX(8500)
        Volume = Player.Volume
        slVolume_Scroll(slVolume, New System.EventArgs())
        For Each drive In Fso.Drives
            cmbDrives.Items.Insert(i, drive.Path)
            i = i + 1
        Next drive
    End Sub

    Private Sub frmPlayer_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
        Dim Button As Short = eventArgs.Button \ &H100000
        Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
        Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
        Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
        '如果鼠标移出Label则改变其颜色
        lblHide.ForeColor = System.Drawing.ColorTranslator.FromOle(&H80000012)
    End Sub

    Private Sub frmPlayer_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
        Player.Stop()
        Player = Nothing
        Col = Nothing
        Fso = Nothing
    End Sub

    Private Sub lblHide_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lblHide.Click
        If VB6.PixelsToTwipsY(Me.Height) = 5200 Then
            Me.Height = VB6.TwipsToPixelsY(2300)
        Else
            Me.Height = VB6.TwipsToPixelsY(5200)
        End If
        Me.Width = VB6.TwipsToPixelsX(8500)
    End Sub

    Private Sub lblHide_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lblHide.DoubleClick
        If VB6.PixelsToTwipsY(Me.Height) = 3855 Then
            Me.Height = VB6.TwipsToPixelsY(1410)
        Else
            Me.Height = VB6.TwipsToPixelsY(3855)
        End If
        Me.Width = VB6.TwipsToPixelsX(6870)
    End Sub

    Private Sub lblHide_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles lblHide.MouseMove
        Dim Button As Short = eventArgs.Button \ &H100000
        Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
        Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
        Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
        '当鼠标移入Label控件则改变其颜色
        lblHide.ForeColor = System.Drawing.ColorTranslator.FromOle(&H80000011)
    End Sub

    Private Sub lstFiles_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lstFiles.SelectedIndexChanged
        Dim Folder As Scripting.Folder
        Dim SubFolder As Scripting.Folder
        Dim File As Scripting.File
        Dim i As Short
        i = 0
        If Not lstFiles.SelectedItems.Count > 1 Then
            If InStr(lstFiles.Text, ":\") Then
                Folder = Fso.GetFolder(lstFiles.Text)
                lstFiles.Items.Clear()
                strFolder = strFolder & "\" & Folder.Name
                '添加所有的*.mp3文件
                For Each File In Folder.Files
                    If InStr(File.Path, ".mp3") Then
                        lstFiles.Items.Insert(i, File.Name)
                        i = i + 1
                    End If
                Next File
                i = lstFiles.Items.Count
                '添加子文件夹
                For Each SubFolder In Folder.SubFolders
                    lstFiles.Items.Insert(i, SubFolder.Path)
                    i = i + 1
                Next SubFolder
            End If
        End If
    End Sub

    Private Sub lstSelected_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lstSelected.DoubleClick
        '开始播放所选择的歌曲
        Dim i As Short
        For i = 0 To lstSelected.Items.Count - 1
            If lstSelected.GetSelected(i) Then
                Player.Stop()
                Playing = i + 1
                Player.Open(Col.Item(Playing))
                Timer1.Enabled = True
                txtSong.Text = VB.Right(Col.Item(Playing), Len(Col.Item(Playing)) - InStrRev(Col.Item(Playing), "\", , CompareMethod.Text))
                Me.Text = "Player - " & txtSong.Text
                Locking(False)
            End If
        Next i
    End Sub

    Private Sub slVolume_Scroll(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles slVolume.Scroll
        Player.Volume = Volume * (1 + (300 - slVolume.Value) / 100)
    End Sub

    Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Timer1.Tick
        If Player.PlayState = MediaPlayer.MPPlayStateConstants.mpStopped Then
            Playing = Playing + 1
            If Playing > Col.Count() Then
                Timer1.Enabled = False
                Exit Sub
            End If
            Player.Open(Col.Item(Playing))
            txtSong.Text = VB.Right(Col.Item(Playing), Len(Col.Item(Playing)) - InStrRev(Col.Item(Playing), "\", , CompareMethod.Text))
            Me.Text = "Player - " & txtSong.Text
        End If
    End Sub

    Private Sub Frame1_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Frame1.Enter

    End Sub
End Class

⌨️ 快捷键说明

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