frmmain.frm

这是网站里可以播放不同音乐的程序

                
                MP.Controls.play
                
                firstPlay = True
                Timer1.Enabled = True
            End If
        Case 4  '停止
            MP.Controls.stop
            firstPlay = True
            Timer1.Enabled = False
            
            I1(2).Picture = I2(2).Picture
            P1(0).Left = 240
            B1.Width = 135
        Case 5  '下一曲
            Call NT(2)
        Case 6  ''添加单个文件
            With frmMain.C
                .DialogTitle = "添加单个音乐文件"
                .FileName = ""
                .ShowOpen
                addSingle .FileName
            End With
        Case 7 '显示/隐藏 文件列表
            frmList.Visible = Not (frmList.Visible)
            I1(Index).Picture = I2(3).Picture
        Case 8 '关闭软件
            Unload Me
        Case 9 '搜索歌曲
            frmNet.webNet.Navigate "http://www.inodea.cn/imusic/result.asp?k=" & txtKey.Text
            frmNet.Show
        Case 10
            Me.WindowState = 1
            frmList.Visible = False
           'Me.Visible = False '程序不可见
           'frmList.Visible = False '列表隐藏
        Case 11
End Select
Go:
Exit Sub
End Sub

Private Sub I1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        I1(Index).Picture = I3(Index).Picture '鼠标左键按下时更改图片
        
        If MP.openState = 13 And Index <> 6 And Index <> 8 And Index <> 10 And Index <> 11 Then
            I1(2).Picture = I3(3).Picture
        End If
    End If
End Sub

Private Sub I1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    I1(Index).Picture = I4(Index).Picture '鼠标指向时更改图片
    
    If MP.playState = wmppsPlaying And Index = 2 And Index <> 6 And Index <> 8 And Index <> 10 And Index <> 11 Then
        I1(2).Picture = I4(3).Picture
    End If
End Sub






Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then X1 = X: Y1 = Y
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim a As Integer
    If Button = 1 Then Me.Top = Me.Top + Y - Y1: Me.Left = Me.Left + X - X1
    For a = 0 To 11
        If a = 3 Or a = 7 Then GoTo 1
        I1(a).Picture = I2(a).Picture   '鼠标移开时恢复按扭图片
1:
    Next a
    
    '暂停按钮
    If MP.playState = wmppsPlaying Then
        I1(2).Picture = I2(3).Picture
    End If
    
    P1(0).Picture = P1(1).Picture
    P2(0).Picture = P2(1).Picture
    
    '按钮时效果
    If frmList.Visible = False Then
        list.Picture = listShow(0).Picture
    Else
        list.Picture = listHide(0).Picture
    End If
    
    If MOVL(0) = True Then frmList.Left = Me.Left: frmList.Top = Me.Top + Me.Height
    If MOVL(1) = True Then frmLrc.Left = Me.Left + Me.Width + 1: frmLrc.Top = Me.Top + 20
    If MOVL(2) = True Then frmNet.Left = Me.Left + Me.Width + 1: frmNet.Top = Me.Top
End Sub

Private Sub Image2_Click()
    Shell "c:\program files\internet explorer\iexplore.exe http://www.inodea.cn"
End Sub

Private Sub labLine_Click()
    frmNet.Visible = Not (frmNet.Visible)
End Sub

Private Sub labLrc_Click()
    frmLrc.Visible = Not (frmLrc.Visible)
End Sub

Private Sub LC_Click()
frmLrc.Visible = Not (frmLrc.Visible)
End Sub

Private Sub list_Click()
    '显示/隐藏 文件列表
    frmList.Visible = Not (frmList.Visible)
    
    If frmList.Visible = False Then
        list.Picture = listShow(0).Picture
    Else
        list.Picture = listHide(0).Picture
    End If
End Sub

Private Sub list_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '按下时效果
    If Button = 1 Then
        If frmList.Visible = False Then
            list.Picture = listShow(1).Picture
        Else
            list.Picture = listHide(1).Picture
        End If
    End If
End Sub

Private Sub list_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '经过时效果
        If frmList.Visible = False Then
            list.Picture = listShow(2).Picture
        Else
            list.Picture = listHide(2).Picture
        End If
End Sub

Private Sub List1_Scroll()
      '-------------------------------  '歌词显示代码
    Dim ss As Integer
    frmLrc.Text1.Text = ""
    For ss = List1.ListIndex - 4 To List1.ListIndex + 5  '显示歌词的前 5 句 和 后 5 句
        frmLrc.Text1.Text = frmLrc.Text1.Text & Mid(List1.list(ss), 6, Len(List1.list(ss)) - 5) & vbNewLine & vbNewLine & vbNewLine
    Next ss
      '--------------------------------- 歌词 EndEnd Sub
End Sub

Private Sub MP_OpenStateChange(ByVal NewState As Long)
    Timer1.Enabled = True
End Sub

Private Sub P1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0
            If Button = 1 Then
                movx = X: jdt = True '拖动时 进度条 跟鼠标走 而不跟播放进度
                P1(Index).Picture = P1(2).Picture
            End If
    End Select
End Sub

Private Sub P1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
    Select Case Index
            Case 0
                P1(Index).Picture = P1(3).Picture
                If MP.playState <> wmppsPlaying Then Exit Sub '如果在播放则允许拖动
                If Button = 1 And P1(Index).Left >= 240 And P1(Index).Left <= 3960 Then
                    P1(Index).Left = P1(Index).Left - movx + X
                    If P1(Index).Left <= 240 Then P1(Index).Left = 240           '这几条用于计算 进度条 拉动位置
                    If P1(Index).Left >= 3960 Then P1(Index).Left = 3960
                End If
                B1.Width = (P1(Index).Left + 20) - 270
    End Select
End Sub

Private Sub P1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Select Case Index
        Case 0
            jdt = False '进度条恢复 跟播放进度走动
            If MP.playState <> wmppsPlaying Then Exit Sub '如果在播放则允许拖动
            MP.Controls.currentPosition = P1(0).Left * (MP.currentMedia.duration / 3600) - (MP.currentMedia.duration / 3600 * 240) '拖动进度条后计算播放位置
            
            P1(Index).Picture = P1(1).Picture
    End Select
End Sub


Private Sub P2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0
            P2(Index).Picture = P2(2).Picture
    End Select
End Sub

Private Sub P2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0
            P2(Index).Picture = P2(3).Picture
            If Button = 1 And P2(Index).Left >= 2360 And P2(Index).Left <= 3690 Then
                P2(Index).Left = P2(Index).Left - movx + X
                If P2(Index).Left <= 2360 Then P2(Index).Left = 2360
                If P2(Index).Left >= 3650 Then P2(Index).Left = 3690
                B2.Width = (P2(Index).Left + 10) - 2360
                MP.settings.volume = Int((P2(Index).Left - 2360) * 0.125)
                P2(Index).ToolTipText = "音量：" & Int((P2(Index).Left - 3650) * 0.125) & "%"
            End If
    End Select
End Sub


Private Sub P2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0
            P2(Index).Picture = P2(1).Picture
    End Select
End Sub




Private Sub Timer1_Timer()
Dim I As String
labTest.Caption = MP.playState
 Select Case MP.playState '侦察状态
       Case 6  '缓冲
            Echo1 = "缓冲处理：" & MP.network.bufferingProgress & " %" '显示缓冲
       Case 9  '连接
          If songinx = 0 Then
             Echo1.Caption = "正在连接媒体.. "
          Else
             Echo1.Caption = "超时重试中.." & songinx
          End If
          frmLrc.Text3.Visible = False
        Case 10 '错误
            '标志为错误链接
            Timer1.Enabled = False
            frmList.playlist.ItemTag(Song) = 2
            If songinx < 3 Then
                MP.Controls.stop
                If frmLrc.Text3.Visible = False Then MP.Controls.play '播放
                songinx = songinx + 1
            Else
                If frmLrc.Text3.Visible = False Then songinx = 0: Call NT(2)  '连接超时则 自动下一曲
            End If
        Case 3 '播放
            '更改音乐信息
            If firstPlay Then
                frmList.playlist.ItemText(Song, 2) = Replace(MP.currentMedia.getItemInfo("title"), """", "")
                frmList.playlist.ItemText(Song, 4) = MP.currentMedia.getItemInfo("Author")
                frmList.playlist.ItemText(Song, 6) = MP.currentMedia.durationString
                
                '播放列表显示
                If m_lngSel < frmList.playlist.itemCount Then frmList.playlist.ItemTag(m_lngSel) = 0
                
                frmList.playlist.ItemTag(Song) = 1
                m_lngSel = Song
            End If
            firstPlay = False
            
            songinx = 0 '链接超时 次数 清零
            If MP.currentMedia.durationString = "00:00" Then Call NT(2) '如果播放文件不正常则跳转下一首
            Echo1.Caption = MP.currentMedia.Name & "(" & MP.currentMedia.durationString & ")" '获取名字
            Echo.Caption = MP.Controls.currentPositionString '& "/" & MP.currentMedia.durationString '显示总时间 显示播放时间
            I = MP.Controls.currentPosition + Mm '检测时间=播放时间加 调整时间 Mm
            
            If jdt = False And MP.currentMedia.duration > 0 Then
              P1(0).Left = 3600 / MP.currentMedia.duration * MP.Controls.currentPosition + 240 '如果进度条未被拖动 则计算出播放进度位置 并移动
              B1.Width = P1(0).Left
            End If
            
            If frmLrc.Visible = False Then Exit Sub '如果没有打开歌词显示窗体 则 不执行歌词显示
            
            'Call showLrc
       Case 2  '暂停
            Echo1.Caption = "暂停播放"
       Case 1  '停止
            Echo1.Caption = "停止播放"
            P1(0).Left = 240  '播放进度条归位
            B1.Width = 20    '播放进度条归位
            Echo.Caption = "00:00" ' 时间显示归零
            Timer1.Enabled = False
            '根据用户选择的播放模式进行播放
            '排序方式0、单曲播放。1、单曲循环。2、顺序播放。3、列表循环。4、随机播放
            Select Case modeType
                Case 0
                    
                Case 1
                    Call NT(3)
                Case 2
                    If Song < frmList.playlist.itemCount - 1 Then
                        If frmLrc.Text3.Visible = False Then Call NT(2)    '自动下一曲
                    End If
                Case 3
                    If Song < frmList.playlist.itemCount - 1 Then
                        If frmLrc.Text3.Visible = False Then Call NT(2)    '自动下一曲
                    Else
                        Song = -1
                        Call NT(2)
                    End If
                Case 4
                    Call NT(4)
            End Select
End Select
    'If MP.playState <> 3 Then Echo1.Left = 10    '如果不是在播放 则 滚动字母 复位
End Sub


Private Sub TTT_Click()
If TTT.Tag = 1 Then
   TTT.Picture = I5(2).Picture
   TTT.Tag = 2                 '更改播放模式 并 更换 图片 靠TAG值 设置播放模式 顺序/随机
Else
   TTT.Picture = I6(2).Picture
   TTT.Tag = 1
End If
End Sub
Private Sub NT(Index As Integer)  '上 / 下 曲控制 过程
    Dim url As String
         If Index = 1 And TTT.Tag = 1 Then   '上一曲
             If Song > 0 And frmList.playlist.itemCount > 0 Then
                Song = Song - 1
                url = frmList.playlist.ItemText(Song, 7) '加载歌曲
             End If
         ElseIf Index = 2 And TTT.Tag = 1 Then  '下一曲
             If Song < frmList.playlist.itemCount - 1 Then
                Song = Song + 1
                url = frmList.playlist.ItemText(Song, 7)  '加载歌曲
             End If
         ElseIf Index = 3 And TTT.Tag = 1 Then  '重播
             url = frmList.playlist.ItemText(Song, 7)  '加载歌曲
         Else                                  '随机时  上/下 曲  随机
             Randomize
             Song = Int(Rnd * (frmList.playlist.itemCount - 1))
             url = frmList.playlist.ItemText(Song, 7)   '加载歌曲
         End If
    
    Timer1.Enabled = False
    firstPlay = True
    
    If Trim(url) = "" Then Exit Sub
    
    MP.url = url: MP.Controls.play     '播放
    Songname = frmList.playlist.ItemText(Song, 2)
    Songpath = Mid(frmList.playlist.ItemText(Song, 7), 1, InStrRev(frmList.playlist.ItemText(Song, 7), "\"))
    Mm = 0 '秒针归位
End Sub



Private Sub txtKey_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        frmNet.webNet.Navigate "http://www.inodea.cn/imusic/result.asp?k=" & txtKey.Text
        frmNet.Show
    End If
End Sub

Private Sub txtKey_LostFocus()
    If txtKey.Text = "" Then
        txtKey.Text = "输入歌名、歌手..."
    End If
End Sub

Private Sub txtKey_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        If txtKey.Text = "输入歌名、歌手..." Then
            txtKey.Text = ""
        End If
    End If
End Sub