音乐播放器(VB编程源代码)

音乐播放器设计一、先来欣赏一下本音乐播放器的最终效果吧：设计思路很简单，即下面两个窗体的设计。

二、主窗体（form1)界面设计如下：主窗体（form1)代码如下：Dim t As Integer, a As BooleanDim p As Integer, b, w As Boolean, onePrivate Sub allclear_Click()'清空播放列表List1.ClearWMP1.currentPlaylist.ClearForm1.Caption = "无任何曲目"End SubPrivate Sub allloop_Click()'全部循环播放Timer3.Enabled = Falseallloop.Checked = Trueoneloop.Checked = Falserand.Checked = Falserule.Checked = FalseCall WMP1.settings.setMode("loop", True)End SubPrivate Sub Form_Load()'初始化Form1.Height = 7800w = Falseallloop.Checked = Falseoneloop.Checked = Falserand.Checked = Falserule.Checked = TrueLabel2.Caption = "00:00"'第一次打开时创建文件If Dir("filepath.text") = "" And Dir("C:\music.txt") = "" ThenOpen "C:\filepath.txt" For Output As #1Close #1Open "C:\music.txt" For Output As #2Close #2End If'读取文件Open "C:\filepath.txt" For Input As #1Open "C:\music.txt" For Input As #2Do While Not EOF(1)Input #1, XInput #2, YIf Dir(X) <> "" ThenList1.AddItem (List1.ListCount + 1) & "." & YCall WMP1.currentPlaylist.insertItem(WMP1.currentPlaylist.Count, WMP1.newMedia(X)) End IfLoopClose #1Close #2'初始化If List1.ListCount <> 0 Then List1.Selected(0) = TruePicture3(0).Width = 114Picture3(0).Height = 52Picture3(0).PaintPicture Picture2(0).Picture, 0, 0, 114, 52, 0, 0, 114, 52Picture3(1).PaintPicture Picture2(2).Picture, 0, 0, 60, 52, 0, 0, 60, 52Picture3(2).PaintPicture Picture2(3).Picture, 0, 0, 83, 52, 0, 0, 83, 52Picture3(4).PaintPicture Picture2(5).Picture, 0, 0, 60, 52, 0, 0, 60, 52Picture3(3).PaintPicture Picture2(4).Picture, 0, 0, 83, 52, 0, 0, 83, 52Picture11.PaintPicture Picture12.Picture, 0, 0, 19, 23, 0, 0, 19, 23a = FalseCall WMP1.settings.setMode("shuffle", False) '初始设置为顺序播放Label1.Caption = Mid(List1.List(0), InStr(List1.List(0), ".") + 1)sd1.Value = 50 '音量设置为50%End SubPrivate Sub List1_DblClick()'双击播放Call WMP1.Controls.playItem(WMP1.currentPlaylist.Item(List1.ListIndex))a = Truet = 1Picture3(0).PaintPicture Picture2(1).Picture, 0, 0, 114, 52, 0, 0, 114, 52End SubPrivate Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If X > List1.Width - 430 Thenw = TrueEnd IfEnd SubPrivate Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '伸缩播放列表If X > List1.Width - 430 And X < List1.Width - 330 ThenList1.MousePointer = 9ElseList1.MousePointer = 0End IfIf w = True And X > 1500 And X < 5800 ThenList1.Width = XEnd IfEnd SubPrivate Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)w = FalseEnd SubPrivate Sub List1_Scroll()List1.MousePointer = 0End SubPrivate Sub oneloop_Click()'单曲循环allloop.Checked = Falseoneloop.Checked = Truerand.Checked = Falserule.Checked = FalseTimer3.Enabled = TrueEnd SubPrivate Sub Pc13_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '播放进度控制If WMP1.playState = wmppsPlaying ThenWMP1.Controls.currentPosition = WMP1.currentMedia.duration * X / 233Pc13.ClsPc13.PaintPicture Pc14.Picture, 0, 0, 233, 17, 234 - X, 0, 233, 17End IfEnd SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '切换图片If t = 0 ThenPicture3(0).PaintPicture Picture2(0).Picture, 0, 0, 114, 52, 0, 0, 114, 52End IfIf t = 1 ThenPicture3(0).PaintPicture Picture2(1).Picture, 0, 0, 114, 52, 0, 0, 114, 52End IfPicture3(1).PaintPicture Picture2(2).Picture, 0, 0, 60, 52, 0, 0, 60, 52Picture3(2).PaintPicture Picture2(3).Picture, 0, 0, 83, 52, 0, 0, 83, 52Picture3(4).PaintPicture Picture2(5).Picture, 0, 0, 60, 52, 0, 0, 60, 52Picture3(3).PaintPicture Picture2(4).Picture, 0, 0, 83, 52, 0, 0, 83, 52End SubPrivate Sub Picture10_Click()'打开搜索窗体Form2.ShowEnd SubPrivate Sub Picture11_Click()'设置静音sd1.Value = 0Picture11.PaintPicture Picture12.Picture, 0, 0, 19, 23, 38, 0, 19, 23End SubPrivate Sub Picture3_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If Index = 0 ThenIf a = True ThenCall WMP1.Controls.pause '播放ElseCall WMP1.Controls.play '暂停End IfEnd IfIf Index = 3 Thenp = 1Call WMP1.Controls.Next '下一首p = 0End IfIf Index = 2 Thenp = 1Call WMP1.Controls.previous '上一首p = 0End IfIf Index = 4 Then Call WMP1.Controls.stop '停止播放'打开音乐文件If Index = 1 ThenCommonDialog1.DialogTitle = "打开音乐文件"CommonDialog1.Filter = "mp3|*.mp3|wma|*.wma"CommonDialog1.InitDir = "D:\"CommonDialog1.ShowOpenfname = CommonDialog1.FileTitlegname = CommonDialog1.FileNameIf fname <> "" Thenn = Len(fname)For i = 0 To List1.ListCount - 1If Right(List1.List(i), n - 4) = Left(fname, n - 4) ThenCall WMP1.Controls.playItem(WMP1.currentPlaylist.Item(i)) '播放添加后的歌曲Timer1.Enabled = TrueList1.ListIndex = iExit SubEnd IfNextList1.AddItem (List1.ListCount + 1) & "." & Left(fname, n - 4) '歌曲无重复则添加到播放列表，否则不再添加Call WMP1.currentPlaylist.insertItem(WMP1.currentPlaylist.Count, WMP1.newMedia(gname))List1.ListIndex = List1.ListCount - 1List1.Selected(i) = TrueCall WMP1.Controls.playItem(WMP1.currentPlaylist.Item(List1.ListIndex))Timer1.Enabled = TrueEnd IfEnd IfEnd SubPrivate Sub Picture3_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)'根据不同情况切换图片，实现动态按钮功能If Index = 0 ThenIf t = 0 ThenIf X < 6 Or X > 80 Or Y < 6 Or Y > 48 ThenPicture3(0).PaintPicture Picture2(0).Picture, 0, 0, 114, 52, 0, 0, 114, 52ElsePicture3(0).PaintPicture Picture2(0).Picture, 0, 0, 114, 52, 228, 0, 114, 52End IfEnd IfIf t = 1 ThenIf X < 6 Or X > 80 Or Y < 6 Or Y > 48 ThenPicture3(0).PaintPicture Picture2(1).Picture, 0, 0, 114, 52, 0, 0, 114, 52ElsePicture3(0).PaintPicture Picture2(1).Picture, 0, 0, 114, 52, 228, 0, 114, 52End IfEnd IfEnd IfIf Index = 1 ThenIf X < 6 Or X > 55 Or Y < 6 Or Y > 48 ThenPicture3(1).PaintPicture Picture2(2).Picture, 0, 0, 60, 52, 0, 0, 60, 52ElsePicture3(1).PaintPicture Picture2(2).Picture, 0, 0, 60, 52, 60, 0, 60, 52End IfEnd IfIf Index = 2 ThenIf X < 6 Or X > 65 Or Y < 6 Or Y > 48 ThenPicture3(2).PaintPicture Picture2(3).Picture, 0, 0, 83, 52, 0, 0, 83, 52ElsePicture3(2).PaintPicture Picture2(3).Picture, 0, 0, 83, 52, 83, 0, 83, 52End IfEnd IfIf Index = 3 ThenIf X < 6 Or X > 65 Or Y < 6 Or Y > 48 ThenPicture3(3).PaintPicture Picture2(4).Picture, 0, 0, 83, 52, 0, 0, 83, 52ElsePicture3(3).PaintPicture Picture2(4).Picture, 0, 0, 83, 52, 166, 0, 83, 52End IfEnd IfIf Index = 4 ThenIf X < 6 Or X > 55 Or Y < 6 Or Y > 48 ThenPicture3(4).PaintPicture Picture2(5).Picture, 0, 0, 60, 52, 0, 0, 60, 52ElsePicture3(4).PaintPicture Picture2(5).Picture, 0, 0, 60, 52, 120, 0, 60, 52End IfEnd IfEnd SubPrivate Sub Picture4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '图片切换'If t = 0 ThenPicture3(0).PaintPicture Picture2(0).Picture, 0, 0, 114, 52, 0, 0, 114, 52End IfIf t = 1 ThenPicture3(0).PaintPicture Picture2(1).Picture, 0, 0, 114, 52, 0, 0, 114, 52End IfPicture3(1).PaintPicture Picture2(2).Picture, 0, 0, 60, 52, 0, 0, 60, 52Picture3(2).PaintPicture Picture2(3).Picture, 0, 0, 83, 52, 0, 0, 83, 52Picture3(4).PaintPicture Picture2(5).Picture, 0, 0, 60, 52, 0, 0, 60, 52Picture3(3).PaintPicture Picture2(4).Picture, 0, 0, 83, 52, 0, 0, 83, 52End SubPrivate Sub Picture5_Click()'显示或隐藏播放列表If b = 0 ThenForm1.Width = 5940Form1.Height = 3900b = 1Picture5.ToolTipText = "显示播放列表"ElseForm1.Width = 5940Form1.Height = 7800b = 0Picture5.ToolTipText = "隐藏播放列表"End IfEnd SubPrivate Sub Picture6_Click()'最小化窗体Form1.WindowState = 1End SubPrivate Sub Picture7_Click()'关闭窗体之前保存播放列表数据Open "C:\filepath.txt" For Output As #1Open "C:\music.txt" For Output As #2For i = 0 To List1.ListCount - 1n = InStr(List1.List(i), ".")Write #1, WMP1.currentPlaylist.Item(i).sourceURLWrite #2, Mid(List1.List(i), n + 1)NextClose #1Close #2EndEnd SubPrivate Sub Picture8_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) '播放模式设置菜单PopupMenu menusetEnd SubPrivate Sub Picture9_Click()'删除菜单PopupMenu gclearEnd SubPrivate Sub rand_Click()'随机播放Timer3.Enabled = Falseallloop.Checked = Falseoneloop.Checked = Falserand.Checked = Truerule.Checked = FalseCall WMP1.settings.setMode("shuffle", True)End SubPrivate Sub rule_Click()'顺序播放Timer3.Enabled = Falseallloop.Checked = Falseoneloop.Checked = Falserand.Checked = Falserule.Checked = TrueCall WMP1.settings.setMode("shuffle", False)End SubPrivate Sub sd1_Change()'音量控制条WMP1.settings.volume = sd1.Valuesd1.ToolTipText = "音量" & sd1.Value & "%'"If sd1.Value = 0 Then sd1.ToolTipText = "静音"If sd1.Value = 100 Then sd1.ToolTipText = "最大音量"If sd1.Value <> 0 ThenPicture11.PaintPicture Picture12.Picture, 0, 0, 19, 23, 0, 0, 19, 23End IfEnd SubPrivate Sub select_Click()'删除选中项For i = 0 To List1.ListCount - 1If List1.Selected(i) ThenList1.RemoveItem (i)m = iCall WMP1.currentPlaylist.RemoveItem(WMP1.currentPlaylist.Item(i)) Exit ForEnd IfNextFor i = 0 To List1.ListCount - 1n = InStr(List1.List(i), ".")List1.List(i) = (i + 1) & "." & Mid(List1.List(i), n + 1)NextIf List1.ListCount = 0 Then Exit SubIf List1.ListCount = m ThenList1.Selected(m - 1) = TrueElseList1.Selected(m) = TrueEnd IfEnd SubPrivate Sub Timer1_Timer()'更新播放动态If WMP1.currentPlaylist.Count <> 0 ThenIf WMP1.playState = 3 ThenLabel2.Caption = WMP1.Controls.currentPositionStringPicture3(0).PaintPicture Picture2(1).Picture, 0, 0, 114, 52, 0, 0, 114, 52a = Truet = 1Picture3(0).ToolTipText = "播放"ElseLabel2.Caption = "00:00"Picture3(0).PaintPicture Picture2(0).Picture, 0, 0, 114, 52, 0, 0, 114, 52a = Falset = 0Picture3(0).ToolTipText = "暂停"End IfEnd IfIf WMP1.playState = 2 ThenLabel2.Caption = WMP1.Controls.currentPositionString '显示播放进度（时间）End IfPc13.ClsIf WMP1.playState = 3 Or WMP1.playState = 2 ThenPc13.PaintPicture Pc14.Picture, 0, 0, 233, 17, 234 - 233 * WMP1.Controls.currentPosition / WMP1.currentMedia.duration, 0, 233, 17End IfEnd SubPrivate Sub Timer2_Timer()'标题动态显示If WMP1.currentPlaylist.Count <> 0 ThenIf WMP1.playState <> 3 ThenForm1.Caption = "暂停播放——" + WMP1.currentMedia.getItemInfo("title")ElseForm1.Caption = "正在播放——" + WMP1.currentMedia.getItemInfo("title")End IfEnd IfEnd SubPrivate Sub Timer3_Timer()'单曲循环If WMP1.currentMedia.duration - 0.5 < WMP1.Controls.currentPosition ThenCall WMP1.Controls.playItem(WMP1.currentPlaylist.Item(one))End IfEnd SubPrivate Sub WMP1_OpenStateChange(ByVal NewState As Long)n = 0If p = 0 ThenFor i = 0 To List1.ListCount - 1If WMP1.currentPlaylist.Item(i).getItemInfo("title") <> WMP1.currentMedia.getItemInfo("title") Thenn = n + 1ElseExit ForEnd IfNextone = nLabel1.Caption = Mid(List1.List(n), InStr(List1.List(n), ".") + 1) '显示正在播放的曲目List1.Selected(n) = TrueEnd IfLabel3.Caption = WMP1.currentMedia.durationString '显示歌曲总长End Sub三、副窗体（form1）界面设计如下：说明:该窗体用于搜索电脑已有歌曲（本音乐播放器的特色所在）副窗体（form1）代码如下：Dim n As Integer, temp(10000) As String, m As IntegerPrivate Sub choose_Click()'选择全部歌曲For i = 0 To List2.ListCount - 1List2.Selected(i) = TrueNext iEnd SubPrivate Sub choosenone_Click()'清除选择For i = 0 To List2.ListCount - 1List2.Selected(i) = FalseNext iEnd SubPrivate Sub Command1_Click()'搜索歌曲并保存Open "C:\searchresult.txt" For Output As #1Open "C:\geresult.txt" For Output As #2List2.ClearDim s As StringCall find(Combo1.Text)If m = n Then s = MsgBox("搜索完毕", vbInformation, "提示")Close #1Close #2End SubPrivate Sub Command2_Click()'将选中歌曲添加到播放列表For i = 0 To List2.ListCount - 1t = 0If List2.Selected(i) = True ThenFor j = 0 To Form1.List1.ListCount - 1n = Len(List2.List(i))If Right(Form1.List1.List(j), n) = List2.List(i) Then t = t + 1: Exit ForNextIf t = 0 ThenForm1.List1.AddItem (Form1.List1.ListCount + 1) & "." & List2.List(i)Call Form1.WMP1.currentPlaylist.insertItem(Form1.WMP1.currentPlaylist.Count, Form1.WMP1.newMedia(List3.List(i)))End IfEnd IfNext iFor i = 1 To List2.SelCountFor j = 0 To List2.ListCount - 1If List2.Selected(j) ThenList2.RemoveItem jList3.RemoveItem jExit ForEnd IfNext jNext is = MsgBox("已添加到播放列表", vbInformation, "提示")End SubPrivate Sub Command3_Click()'读取文件（上次最后一次搜索结果）If Dir("C:\searchresult.txt") <> "" And Dir("C:\geresult.txt") <> "" ThenOpen "C:\searchresult.txt" For Input As #1Open "C:\geresult.txt" For Input As #2Do While Not EOF(1)Input #1, XInput #2, YList3.AddItem XList2.AddItem YLoopClose #1Close #2s = MsgBox("上次搜索结果读取完成！", vbInformation, "提示")Elses = MsgBox("没有任何搜索记录！", vbInformation, "提示")End IfEnd SubPrivate Sub Form_Load()'选择搜索条件即路径和文件格式Combo1.Text = Combo1.List(0)Combo2.Text = Combo2.List(0)Form2.Picture = LoadPicture("")End SubPrivate Function find1() '文件搜索函数Dim i As StringDim a As Integer, b As Integera = m:b = nDim k As IntegerFor k = a To bIf temp(k) = "" Then Exit Functionfind (temp(k))NextEnd Function'*************************************'获取该路径下的文件，并且存储目录文件的路径******************************************Private Function find(ByVal path As String) '文件搜索函数Dim i As Stringm = ni = Dir(path, vbDirectory)Do While i <> ""If i <> "." And i <> ".." ThenIf (GetAttr(path & i) And vbDirectory) <> 0 Thentemp(n) = path & i & "\"n = n + 1ElseDoEventsIf Right(i, Len(Combo2.Text)) = Combo2.Text ThenList3.AddItem path & iWrite #1, path & iWrite #2, Left(i, Len(i) - 4)List2.AddItem Left(i, Len(i) - 4)End IfEnd IfEnd Ifi = DirLoopfind1End Function总结：本音乐播放器的界面还可以设计的更加漂亮好看，这个就得发挥你的界面设计能力咯！以上播放器的设计还有很多可以改善的地方，比如代码能否更加简化？还缺少哪些功能？如何更加赏心悦目？这些就交给你自己去完善咯！另外，为了方便有兴趣的人更好的理解整个设计过程，我已共享该音乐播放器程序设计的整个工程文件（本程序用到的图片也含有）到以下网址：可以下载看看，希望对你有所帮助！。