【原创】VBA， 用VBA写了一个简单的音乐播放器shell

 

目标：（现在的2个版本都觉得不太好，需要改进）

• 主要目的为了实现，选歌
• 根据歌曲进度显示歌词
• 添加歌曲---计划以后做
• 下面是UI和歌词数据表

 

 

1 版本1：需要双击切换歌曲

1.1 功能

• 实现，选歌
• 实现，根据选歌，更换小图，更换背景，播放音乐
• 实现，根据选歌，滚动显示歌曲名，根据歌曲节奏播放歌词（只有起风了歌词节奏对过）

 

1.2 局限性

• 需要双击选歌。。。。
• 本来意图是切换listbox里的值就行，但好像listbox1_change() 在 do while 过程中不能重复激活。。。或者还没找到合适的办法

 

1.3 效果

 

1.4 代码

Dim c1, l1

Private Sub ListBox1_Change()
   c1 = 1
   l1 = ListBox1.Value
   time1 = Timer()
   If Timer() < time1 + 1 Then
        If c1 = 1 Then
           c1 = 0
        End If
   End If
End Sub

Private Sub ListBox1_Click()
'这个会找不到listbox1.value ？是因为没执行,debug.print 都不执行？
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r1 As Range


Set r1 = Worksheets("中文歌").Range(Cells(1, 1), Cells(1, Worksheets("中文歌").Cells(1, 9999).End(xlToLeft).Column)).Find(l1)

Image1.Picture = LoadPicture(Worksheets("中文歌").Cells(2, r1.Column))
Me.Picture = LoadPicture(Worksheets("中文歌").Cells(2, r1.Column))
WindowsMediaPlayer1.URL = Worksheets("中文歌").Cells(3, r1.Column)
WindowsMediaPlayer1.Controls.Play

k = 4
m = "               " & Worksheets("中文歌").Cells(1, r1.Column).Value & "              "
Label1.Caption = m


Do While c1 = 0 
time1 = Timer()
t = Worksheets("中文歌").Cells(k, 1 + r1.Column)
Label2.Caption = Worksheets("中文歌").Cells(k, r1.Column)
Do
  DoEvents
         '平行的话，这个快速循环会被堵住？所以只能套在里面
        time0 = Timer()
        Do
          DoEvents
        Loop While Timer < time0 + 0.1
        m = Right(m, Len(m) - 1) & Left(m, 1)
        Label1.Caption = m

Loop While Timer() < time1 + t
k = k + 1
Loop
End Sub


Private Sub ListBox1_Enter()
'listbox1.value 没改变时一般为空，会查到0
End Sub


Private Sub UserForm_Initialize()
'初始化listbox1
For i = 2 To Worksheets("中文歌").Cells(1, 9999).End(xlToLeft).Column
    If Not Worksheets("中文歌").Cells(1, i) = "" Then
        ListBox1.AddItem Worksheets("中文歌").Cells(1, i)
    End If
Next
End Sub


Private Sub CommandButton1_Click()
Load addmusic
addmusic.Show vbModeless
End Sub

 

 

2  版本2： 播放过程中无法实现切换

2.1 实现效果（点选改变listbox的值即可，不需要双击）

• 这个版本代码结构比较简单清晰
• 其他都一样
• 但是一旦选了第一首歌曲后，播放过程中无法切换
• 怀疑是因为   listbox1_change() 不能打断  do  while 过程，重复激活，而 do while 也不能用再次 change 作为结束条件，很尴尬，可能是我还不会

Private Sub UserForm_Initialize()

'初始化listbox1
For i = 2 To Worksheets("中文歌").Cells(1, 9999).End(xlToLeft).Column
    If Not Worksheets("中文歌").Cells(1, i) = "" Then
        ListBox1.AddItem Worksheets("中文歌").Cells(1, i)
    End If
Next
End Sub



Private Sub ListBox1_Change()
Dim r1 As Range
Set r1 = Worksheets("中文歌").Range(Cells(1, 1), Cells(1, Worksheets("中文歌").Cells(1, 9999).End(xlToLeft).Column)).Find(ListBox1.Value)

Image1.Picture = LoadPicture(Worksheets("中文歌").Cells(2, r1.Column))
Me.Picture = LoadPicture(Worksheets("中文歌").Cells(2, r1.Column))
WindowsMediaPlayer1.URL = Worksheets("中文歌").Cells(3, r1.Column)
WindowsMediaPlayer1.Controls.Play

k = 4
m = "               " & Worksheets("中文歌").Cells(1, r1.Column).Value & "              "
Label1.Caption = m

Do
time1 = Timer()
t = Worksheets("中文歌").Cells(k, 1 + r1.Column)
Label2.Caption = Worksheets("中文歌").Cells(k, r1.Column)
Do
  DoEvents
         '平行的话，这个快速循环会被堵住？所以只能套在里面
        time0 = Timer()
        Do
          DoEvents
        Loop While Timer < time0 + 0.1
        m = Right(m, Len(m) - 1) & Left(m, 1)
        Label1.Caption = m

Loop While Timer() < time1 + t
k = k + 1
Loop While 1  '想知道停止状态，WindowsMediaPlayer1.Controls = False

End Sub



Private Sub CommandButton1_Click()
Load addmusic
addmusic.Show vbModeless
End Sub

 

3 很多关于listbox的功能疑惑

• 我发现的一些问题，应该都是没学懂
• listbox1_click  居然不会触发
• listbox_enter     这时候取到的listbox1.value可能为空
• listbox1_change 不能重复触发。。。播放过程中，change事情发生了，不能再次触发change,而是do--while一直执行很尴尬

 

 

4 搞清楚这些问题后，想写个改进版