📄 frmplayer.vb
字号:
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 + -