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

📄 playmp3.frm

📁 功能描述]VB 5.0下开发的MP3播放器
💻 FRM
📖 第 1 页 / 共 3 页
字号:
        Line1.Visible = True
        Line2.Visible = True
        Line3.Visible = True
        Line4.Visible = True
    Else
        Line1.Visible = False
        Line2.Visible = False
        Line3.Visible = False
        Line4.Visible = False
    End If
    
End Sub

Sub Line_Click(bShowFlag As Boolean)
    If bShowFlag = True Then    '允许按钮显示
        Line1.BorderColor = RGB(0, 0, 0)
        Line2.BorderColor = RGB(255, 255, 255)
        Line3.BorderColor = RGB(0, 0, 0)
        Line4.BorderColor = RGB(255, 255, 255)
    Else
        Line1.BorderColor = RGB(255, 255, 255)
        Line2.BorderColor = RGB(0, 0, 0)
        Line3.BorderColor = RGB(255, 255, 255)
        Line4.BorderColor = RGB(0, 0, 0)
    End If
End Sub

Private Sub Image4_Click(Index As Integer)
    Image4(Index).Visible = False   '置循环标志和图标
    If Index = 2 Then
        Image4(0).Visible = True
    Else
        Image4(Index + 1).Visible = True
    End If
    
    If Image4(0).Visible = True Then
        bRepeatFlag = 0
    ElseIf Image4(1).Visible = True Then
        bRepeatFlag = -1
    ElseIf Image4(2).Visible = True Then
        bRepeatFlag = 1
    End If
End Sub

Private Sub Label1_Click()
    On Error GoTo error_handle
    
    If bVolumeFlag = 1 Then '置声道模式和图标
        bVolumeFlag = -1
    Else
        bVolumeFlag = bVolumeFlag + 1
    End If
    
    Select Case bVolumeFlag
        Case 0
            Label1.Caption = "立体声"
            If bOpenFlag = True Then
                Mp3Play.SetVolumeP nLeftVolume, nRightVolume
            End If
        Case -1
            Label1.Caption = "左声道"
            If bOpenFlag = True Then
                Mp3Play.SetVolumeP nLeftVolume, 0
            End If
        Case 1
            Label1.Caption = "右声道"
            If bOpenFlag = True Then
                Mp3Play.SetVolumeP 0, nRightVolume
            End If
        End Select

    Exit Sub
error_handle:
            ErrorLabel.Caption = Error
            Resume Next
End Sub


Private Sub Label3_Click()
    bOnTopFlag = Not bOnTopFlag '置窗口状态标志和颜色
    If bOnTopFlag = True Then
        PutWindowOnTop Me, True
        Label3.ForeColor = RGB(255, 0, 0)
    Else
        PutWindowOnTop Me, False
        Label3.ForeColor = RGB(191, 191, 191)
    End If
End Sub

Private Sub Timer1_Timer()
    If bLineShowFlag = True Then    '按钮已经按下
        bLineShowFlag = False
        Line_Click False
        Timer1.Interval = 0
    End If
End Sub

Sub Get_FileName()
    Dim cString As String
    Dim nLen, nFileCount, nOldLen As Integer    '文件名长度,文件数
    Dim nValue As Integer   '控件的返回值
    
    nLen = 0
    nFileCount = 0
    nOldLen = 1
    
    CommDial.filename = ""  '初始化文件名
    CommDial.MaxFileSize = 16384    '设定文件名缓冲区
    CommDial.Filter = "*.Mp2,*.Mp3|*.Mp3;*.Mp2" '指定文件类型
    CommDial.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames   '允许多选和长文件名
    CommDial.ShowOpen   '显示打开文件窗口
    
    cString = Trim(CommDial.filename) & Chr(32)  '保存选取的文件

    If Len(Trim(cString)) > 4 Then  '文件名存在
        For nLen = 1 To Len(cString)
            If Asc(Mid(cString, nLen, 1)) = 32 Then '含有空格
                nFileCount = nFileCount + 1 '文件数累计
            End If
        Next nLen
        
        
        If nFileCount = 1 Then  '选定了一个文件
            ReDim cFileName(1) As String   '重新定义文件名数组
            For nLen = 1 To Len(cString)
                If Asc(Mid(cString, nLen, 1)) = 92 Then '含有"\"
                    nOldLen = nLen '记住"\"的位置
                End If
            Next nLen
            
            cFileName(0) = Trim(Mid(cString, 1, nOldLen - 1))   '取出文件路径
            cFileName(1) = Trim(cString)    '取出文件名
            ErrorLabel.Caption = "共选择了1个文件 !"
        Else    '选定了多个文件
            ReDim cFileName(nFileCount - 1) As String '重新定义文件名数组
            nFileCount = 0  '重新初始化文件数
            
            For nLen = 1 To Len(cString)
                If Asc(Mid(cString, nLen, 1)) = 32 Then
                    If nFileCount = 0 Then  '取出文件路径
                        cFileName(nFileCount) = Trim(Mid(cString, nOldLen, nLen - nOldLen))
                    Else    '文件路径+文件名
                        cFileName(nFileCount) = cFileName(0) & "\" & Trim(Mid(cString, nOldLen, nLen - nOldLen))
                    End If
                    
                    nFileCount = nFileCount + 1
                    nOldLen = nLen
                End If
            Next nLen
            ErrorLabel.Caption = "共选择了" & nFileCount - 1 & "个文件 !"
        End If
    Else
        ErrorLabel.Caption = "没有选择任何文件 !"
    End If
    
    On Error GoTo error_handle
    bPlayFlag = False   '播放标志为假
    bSkipFlag = 0   '正常播放
    If UBound(cFileName) > 0 And Len(Trim(cFileName(1))) > 4 Then  '文件列表存在
        Label4.Caption = "总 计 : " & UBound(cFileName)
        If bOpenFlag = True Then    '已有文件打开
            Mp3Play.Close   '把打开的文件关闭
        End If

        nValue = Mp3Play.Open(cFileName(1), "")
        If nValue = 0 Then
            nCount = 1
            bOpenFlag = True
        Else
            bOpenFlag = False
        End If
    End If
            
    Exit Sub
error_handle:
        ErrorLabel.Caption = Error
        Resume Next

End Sub

Private Sub Mp3Play_ActFrame(ByVal ActFrame As Long)
    Dim nHour As Integer
    Dim nMinute As Integer
    Dim nSecond As Integer
    Dim dTime As Data
    Dim cTime As String
    
    nHour = Int(((ActFrame * Mp3Play.MsPerFrame) \ 1000) / 3600)    '小时
    nMinute = Int(((ActFrame * Mp3Play.MsPerFrame) \ 1000) / 60)    '分
    nSecond = ((ActFrame * Mp3Play.MsPerFrame) \ 1000) Mod 60   '秒
    cTime = nHour & ":" & nMinute & ":" & nSecond
    cTime = Format(cTime, "hh:mm:ss")   '显示格式

    Label2.Caption = cTime
    Dim nLen As Single
    nFrameCount = ActFrame
    nLen = ActFrame / Mp3Play.FrameCount
    Line5.X2 = Int(nLen * Picture1.Width * 15) + Line5.X1   '进度线
End Sub

Private Sub Mp3Play_ThreadEnded()
    Dim nValue As Integer   '控件的返回值
    On Error GoTo error_handle
    bOpenFlag = False
    bPlayFlag = True   '播放标志为真
    Label2.Caption = "00:00:00"
    Label5.Caption = ""
    Label5.Left = Picture1.Width * 15
    Select Case bSkipFlag
        Case 0  '正常播放
            Select Case bRepeatFlag
                Case 0  '不循环
                    If nCount < UBound(cFileName) Then  '当前文件数不是最后一个
                        nCount = nCount + 1 '自动播放下一首歌曲
                        nValue = Mp3Play.Open(cFileName(nCount), "")
                        If nValue = 0 Then
                            bOpenFlag = True
                            bPlayFlag = False   '播放标志为假
                            Image1_Click (2)    '开始播放
                        Else
                            bOpenFlag = False
                        End If
                    Else
                        nCount = 1 '自动播放第一首歌曲
                        nValue = Mp3Play.Open(cFileName(nCount), "")
                        If nValue = 0 Then
                            bOpenFlag = True
                            bPlayFlag = False   '播放标志为假
                            ErrorLabel.Caption = "所有文件播放完毕 !"
                        Else
                            bOpenFlag = False
                        End If
                    End If
                Case -1 '单首循环
                        nValue = Mp3Play.Open(cFileName(nCount), "")
                        If nValue = 0 Then
                            bOpenFlag = True
                            bPlayFlag = False   '播放标志为假
                            Image1_Click (2)    '开始播放
                        Else
                            bOpenFlag = False
                        End If
                Case 1  '全部循环
                    If nCount < UBound(cFileName) Then  '当前文件数不是最后一个
                        nCount = nCount + 1 '自动播放下一首歌曲
                    Else    '当前文件数是最后一个
                        nCount = 1  ''自动播放第一首歌曲
                    End If
                    nValue = Mp3Play.Open(cFileName(nCount), "")
                    If nValue = 0 Then
                        bOpenFlag = True
                        bPlayFlag = False   '播放标志为假
                        Image1_Click (2)    '开始播放
                    Else
                        bOpenFlag = False
                    End If
                    
                    bSkipFlag = 0
            End Select
            
        Case 1, -1  '下一首和上一首
            nValue = Mp3Play.Open(cFileName(nCount), "")
            If nValue = 0 Then
                bOpenFlag = True
                bPlayFlag = False   '播放标志为假
                Image1_Click (2)    '开始播放
            Else
                bOpenFlag = False
            End If
            
            bSkipFlag = 0
        Case 100
            nValue = Mp3Play.Open(cFileName(1), "")
            If nValue = 0 Then
                bOpenFlag = True
                bPlayFlag = False   '播放标志为假
            Else
                bOpenFlag = False
            End If
        
        Case -100
            bSkipFlag = 0
    End Select
    
    Exit Sub

error_handle:
        ErrorLabel.Caption = Error
        Resume Next
End Sub

Private Sub Timer2_Timer()  '控制文字移动
    Dim nVolume As Integer
    
    If ErrorLabel.Left + ErrorLabel.Width > 0 Then
        ErrorLabel.Left = ErrorLabel.Left - 15
    Else
        If Trim(Label5.Caption) <> "" Then   '两个标签产生40个像素的距离
            If Label5.Left + Label5.Width + 600 < Picture1.Width * 15 Then
                ErrorLabel.Left = Picture1.Width * 15
            End If
        Else
            ErrorLabel.Left = Picture1.Width * 15
        End If
    End If
    
    If Trim(Label5.Caption) <> "" Then
        If Label5.Left + Label5.Width > 0 Then
            If ErrorLabel.Left + ErrorLabel.Width + 600 < Picture1.Width * 15 _
                Or Label5.Left < Picture1.Width * 15 Then
                Label5.Left = Label5.Left - 15
            End If
        Else
            If ErrorLabel.Left + ErrorLabel.Width + 600 < Picture1.Width * 15 Then
                Label5.Left = Picture1.Width * 15
            End If
        End If
    End If
    
    If nRepeatTime < 20 Then
        nRepeatTime = nRepeatTime + 1
    End If
    
    On Error Resume Next

    
    If bOpenFlag = True Then    '已经打开了文件
        If bVolumeValueFlag = False Then    '尚未读取音量
            bVolumeValueFlag = True
            nLeftVolume = Mp3Play.GetVolumeLeftP
            nRightVolume = Mp3Play.GetVolumeRightP
        End If

        If bVolumeFlag = -1 Then    '左声道
            nVolume = Mp3Play.GetVolumeLeftP
        Else        '右声道或立体声
            nVolume = Mp3Play.GetVolumeRightP
        End If
        
        If nVolume > 100 Then
            nVolume = 100
        ElseIf nVolume < 0 Then
            nVolume = 0
        End If
        Image5.Width = Int((nVolume / 100 * 900) / 15) * 15
    End If
End Sub

Private Sub Pic_Set(Index As Integer)
    PicClip(Index).ClipX = 0
    PicClip(Index).ClipY = 0
    
    PicClip(Index).ClipHeight = PicClip(Index).Height
    PicClip(Index).ClipWidth = PicClip(Index).Width
           
    Me.Picture = PicClip(Index).Clip

End Sub

⌨️ 快捷键说明

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