playmp3.frm

一个mp3播放器的源码

                Image4(2).Visible = True     '显示循环图标
            End If
            
        Case 10
            If bPauseFileFlag = False Then
                    MList95.Show vbModal
            End If
                
            If bModiFileListFlag = True Then    '文件列表发生变化
                bModiFileListFlag = False
                cPlayMessage = "列表改变"
                Mp3Play.Close
                
                If bPlayFileFlag = False Then
                    Mp3Play_ThreadEnded
                End If
            End If
        Case 11
            frmAbout.Show vbModal
        Case 12 '最小化
            Randomize   '产生0-1之间的随机数
            Call PhaseOutForm(Int((1 - 0 + 1) * Rnd + 0), Me)
            Me.Hide

            nid.cbSize = Len(nid)
            nid.hwnd = Me.hwnd
            nid.uId = vbNull
            nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
            nid.uCallBackMessage = WM_MOUSEMOVE
            nid.szTip = "MP3 播放器 SuperMP3 Ver 2.10 开发：赵洪涛" & vbNullChar
            
            bMinimizeFlag = True
            Shell_NotifyIcon NIM_ADD, nid
                            
        Case 15 '更换界面
            If nPicCount = 4 Then
                nPicCount = 0
            Else
                nPicCount = nPicCount + 1
            End If
            
            Pic_Set nPicCount   '更换界面
            WritePrivateProfileString "Screen", "nScreenCount", CStr(nPicCount), App.Path & "\Filelist.lst"
            
        Case 16 '建立关联
            cString = "警告：本功能是建立扩展名为.MP3.和.MP2的文件与本程"
            cString = cString & "序关联。如果上述类型文件已经与其它应用程序"
            cString = cString & "建立了关联，本功能将改变其关联，使之与本程序"
            cString = cString & "关联。确实要这样做吗 ？"
            
            If MsgBox(cString, 4 + 32 + 256, "提示信息") = vbYes Then
                CreateAssociation
            End If
        Case 17 '静音
            If bMuteVolumeFlag = False Then
                SetMute volMute, True
                bMuteVolumeFlag = True
                Image1(17).ToolTipText = "消除静音"
            Else
                SetMute volMute, False
                bMuteVolumeFlag = False
                Image1(17).ToolTipText = "静音"
            End If
    End Select
    Exit Sub
    
error_handle:
    If Trim(Error) = "Unable to read MPEG-Header" Then
        ErrorLabel.Caption = "fff此文件不存在或不是标准格式 ！"
        bOpenFileFlag = False
    Else
        ErrorLabel.Caption = Error
    End If
    
    Resume Next
    
End Sub

Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Index = 13 Then
        nLeftVolume = -1000
        Timer5.Enabled = True
    End If
    
    If Index = 14 Then
        nLeftVolume = 1000
        Timer5.Enabled = True
    End If
End Sub

Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Line_Move Index, True   '显示按钮
    Timer1.Enabled = True
    Label1.Caption = Image1(Index).ToolTipText  '显示注释
End Sub

Sub Line_Move(Index As Integer, bShowFlag As Boolean)

    If bShowFlag = True Then    '允许按钮显示
        Line1.X1 = Image1(Index).Left
        Line1.X2 = Image1(Index).Left + Image1(Index).Width
        Line2.X1 = Image1(Index).Left
        Line2.X2 = Image1(Index).Left + Image1(Index).Width
        Line3.X1 = Image1(Index).Left
        Line3.X2 = Image1(Index).Left
        Line4.X1 = Image1(Index).Left + Image1(Index).Width
        Line4.X2 = Image1(Index).Left + Image1(Index).Width
        
        Line1.Y1 = Image1(Index).Top
        Line1.Y2 = Image1(Index).Top
        Line2.Y1 = Image1(Index).Top + Image1(Index).Height
        Line2.Y2 = Image1(Index).Top + Image1(Index).Height
        Line3.Y1 = Image1(Index).Top
        Line3.Y2 = Image1(Index).Top + Image1(Index).Height
        Line4.Y1 = Image1(Index).Top
        Line4.Y2 = Image1(Index).Top + Image1(Index).Height
        
        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 Image1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer5.Enabled = False
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 bOpenFileFlag = True Then
                Mp3Play.SetVolumeP nRightVolume, nRightVolume
            End If
        Case -1
            Label1.Caption = "左声道"
            If bOpenFileFlag = True Then
                Mp3Play.SetVolumeP nRightVolume, 0
            End If
        Case 1
            Label1.Caption = "右声道"
            If bOpenFileFlag = True Then
                Mp3Play.SetVolumeP 0, nRightVolume
            End If
        End Select

    Exit Sub

error_handle:
    If Trim(Error) = "Unable to read MPEG-Header" Then
        ErrorLabel.Caption = "eeeee此文件不存在或不是标准格式 ！"
        bOpenFileFlag = False
    Else
        ErrorLabel.Caption = Error
    End If
    
    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 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
    Dim nLen As Single
    Dim nValue As Integer
    
    If bShowTimeFlag = False Then
        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")   '显示格式
    Else
        nValue = Int(Mp3Play.TotalTime / 1000)
        nValue = nValue - Int((ActFrame * Mp3Play.MsPerFrame) \ 1000)
        nHour = Int(nValue / 3600)    '小时
        nMinute = Int(nValue / 60)   '分
        nSecond = nValue Mod 60   '秒
        cTime = nHour & ":" & nMinute & ":" & nSecond
        cTime = Format(cTime, "hh:mm:ss")   '显示格式
    End If
    
    lcdTest.Caption = cTime
    
    nFrameCount = ActFrame
    nLen = Format(ActFrame / Mp3Play.FrameCount, "###0.00")
    Label6.Left = Int(nLen * Picture1.Width) + Line5.X1 - (Label6.Width / 2) '进度线
    Line5.X2 = Label6.Left + 15
End Sub

Private Sub Pic_Set(Index As Integer)   '设置换肤
    PicClip(Index).ClipX = 1    '从1开始而不丛0开始，是为了去掉界面四周的黑框
    PicClip(Index).ClipY = 1
    
    PicClip(Index).ClipHeight = PicClip(Index).Height - 1
    PicClip(Index).ClipWidth = PicClip(Index).Width - 1
           
    Me.Picture = PicClip(Index).Clip

End Sub

Private Sub Mp3Play_ThreadEnded()

On Error GoTo error_handle
    lcdTest.Caption = "00:00:00"
    Line5.X2 = Line5.X1 + 15
    Label6.Left = Line5.X1 - (Label6.Width / 2)
    ErrorLabel.Caption = "MP3 播放器 V2.10     赵洪涛编于2001年3月"
    
    If bFileList = True Then
        Label5.Caption = "共选择了" & UBound(cFileNameList) & "个文件 ！"
    End If
    
    nid.hIcon = Me.Icon
    Shell_NotifyIcon NIM_MODIFY, nid
    
    Select Case Trim(cPlayMessage)
        
        Case "初始化"
            If bFileList = False Then
                bOpenFileFlag = False
                bPlayFileFlag = False
                Label5.Caption = "没有打开任何文件 ！"
            Else
                Label4.Caption = "总 计：" & UBound(cFileNameList)
                Label5.Caption = "共选择了" & UBound(cFileNameList) & "个文件 ！"
                nPlayFileCount = 1
                If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                    bOpenFileFlag = True
                Else
                    bOpenFileFlag = False
                End If
                bPlayFileFlag = False
            End If
        
        Case "关闭"
                ErrorLabel.Caption = "MP3 播放器 V2.10     赵洪涛编于2001年3月"
                Label5.Caption = "共选择了" & UBound(cFileNameList) & "个文件 ！"
                nPlayFileCount = 1
                If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                    bOpenFileFlag = True
                Else
                    bOpenFileFlag = False
                End If
                bPlayFileFlag = False
        Case "列表改变"

            If bFileList = False Then
                bOpenFileFlag = False
                bPlayFileFlag = False
                Label5.Caption = "没有打开任何文件 ！"
            Else
                Label4.Caption = "总 计：" & UBound(cFileNameList)
                Label5.Caption = "共选择了" & UBound(cFileNameList) & "个文件 ！"
                If bDbClickItemFlag = False Then
                    nPlayFileCount = 1
                Else
                    bDbClickItemFlag = False
                End If
                If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                    bOpenFileFlag = True
                Else
                    bOpenFileFlag = False
                End If
                bPlayFileFlag = False
                Image1_Click (2)
            End If
        
        Case "上一个"
            If nPlayFileCount > 1 Then
                nPlayFileCount = nPlayFileCount - 1
            Else
                nPlayFileCount = UBound(cFileNameList)
            End If
            
            If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                bOpenFileFlag = True
            Else
                bOpenFileFlag = False
            End If
            bPlayFileFlag = False
            Image1_Click (2)
            
        Case "下一个"
            If nPlayFileCount < UBound(cFileNameList) Then
                nPlayFileCount = nPlayFileCount + 1
            Else
                nPlayFileCount = 1
            End If
            
            If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                bOpenFileFlag = True
            Else
                bOpenFileFlag = False
            End If
            bPlayFileFlag = False
            Image1_Click (2)
        
        Case "播放"
            Select Case bRepeatFlag
                Case -1 '循环单首
                    If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                        bOpenFileFlag = True
                    Else
                        bOpenFileFlag = False
                    End If
                    bPlayFileFlag = False
                    Image1_Click (2)
                Case 0  '不循环
                    If nPlayFileCount < UBound(cFileNameList) Then
                        nPlayFileCount = nPlayFileCount + 1
                        If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                            bOpenFileFlag = True
                        Else
                            bOpenFileFlag = False
                        End If
                        bPlayFileFlag = False
                        Image1_Click (2)
                    Else
                        nPlayFileCount = 1
                        If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                            bOpenFileFlag = True
                        Else
                            bOpenFileFlag = False
                        End If
                        bPlayFileFlag = False
                        Label5.Caption = "所有文件播放完毕 ！"
                    End If
                Case 1  '循环所有
                    If nPlayFileCount < UBound(cFileNameList) Then
                        nPlayFileCount = nPlayFileCount + 1
                        If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                            bOpenFileFlag = True
                        Else
                            bOpenFileFlag = False
                        End If
                        bPlayFileFlag = False
                        Image1_Click (2)
                    Else
                        nPlayFileCount = 1
                        If Mp3Play.Open(Trim(cFilePathList(nPlayFileCount)) & "\" & Trim(cFileNameList(nPlayFileCount)), "") = 0 Then
                            bOpenFileFlag = True
                        Else
                            bOpenFileFlag = False
                        End If
                        bPlayFileFlag = False
                        Image1_Click (2)
                    End If
            End Select
            
    End Select
    Exit Sub
    
error_handle:
    If Trim(Error) = "Unable to read MPEG-Header" Then
        ErrorLabel.Caption = "ddddd此文件不存在或不是标准格式 ！"