playmp3.frm

一个mp3播放器的源码

   Begin VB.Image Image1 
      Height          =   315
      Index           =   12
      Left            =   7095
      ToolTipText     =   "最小化"
      Top             =   45
      Width           =   300
   End
   Begin VB.Line Line2 
      Visible         =   0   'False
      X1              =   720
      X2              =   1020
      Y1              =   630
      Y2              =   630
   End
   Begin VB.Menu Menu 
      Caption         =   "Menu"
      Visible         =   0   'False
      Begin VB.Menu PopMenu 
         Caption         =   "恢复"
         Index           =   1
      End
      Begin VB.Menu PopMenu 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu PopMenu 
         Caption         =   "播放列表"
         Index           =   3
      End
      Begin VB.Menu PopMenu 
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu PopMenu 
         Caption         =   "停止"
         Index           =   5
      End
      Begin VB.Menu PopMenu 
         Caption         =   "播放"
         Index           =   6
      End
      Begin VB.Menu PopMenu 
         Caption         =   "暂停"
         Index           =   7
      End
      Begin VB.Menu PopMenu 
         Caption         =   "-"
         Index           =   8
      End
      Begin VB.Menu PopMenu 
         Caption         =   "后退"
         Index           =   9
      End
      Begin VB.Menu PopMenu 
         Caption         =   "快进"
         Index           =   10
      End
      Begin VB.Menu PopMenu 
         Caption         =   "-"
         Index           =   11
      End
      Begin VB.Menu PopMenu 
         Caption         =   "上一首"
         Index           =   12
      End
      Begin VB.Menu PopMenu 
         Caption         =   "下一首"
         Index           =   13
      End
      Begin VB.Menu PopMenu 
         Caption         =   "-"
         Index           =   14
      End
      Begin VB.Menu PopMenu 
         Caption         =   "关于 ..."
         Index           =   15
      End
      Begin VB.Menu PopMenu 
         Caption         =   "-"
         Index           =   16
      End
      Begin VB.Menu PopMenu 
         Caption         =   "退出"
         Index           =   17
      End
   End
End
Attribute VB_Name = "PlayMp3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim lcdTest As New mcLcd
Dim nid As NOTIFYICONDATA
Dim bOpenFileFlag As Boolean    '打开文件标志
Dim bPlayFileFlag As Boolean    '播放文件标志
Dim bPauseFileFlag As Boolean   '暂停播放文件标志
Dim bRepeatFlag As Integer, nRepeatTime As Integer  '循环标志
Dim nFrameCount As Integer   '正在播放的文件的祯数
Dim cPlayMessage As String  '功能说明
Dim bVolumeFlag As Integer  '声道标志
Dim nLeftVolume As Integer '左声道音量
Dim nRightVolume As Integer '右声道音量
Dim bVolumeValueFlag As Boolean '取音量标志
Dim bMuteVolumeFlag As Boolean '消音标志
Dim bMinimizeFlag As Boolean '最小化标志
Dim bShowTimeFlag As Boolean    '显示剩余时间标志
'Dim DrawStart As Boolean, bDrawLineFlag As Boolean  '开始拖动标志,画线标志
'Dim nX As Integer, nY As Integer    '旧的坐标
Dim nPicCount As Integer, bOnTopFlag As Boolean    '界面序号，总在最前标志






Private Sub Form_Load()
    Dim cString As String
    Dim cFileName As String
    Dim cFilePath     As String
    
    If App.PrevInstance = True Then
        End
    End If
    
    lcdTest.NewLCD Picture2
    lcdTest.Caption = "00:00:00"
    
    Call GetFileList
    
    If nScreenCount <= -1000 Then
        Randomize   '产生0-4之间的随机数
        nPicCount = Int((4 - 0 + 1) * Rnd + 0)
        Pic_Set nPicCount   '设置界面
    Else
        Pic_Set nScreenCount   '设置界面
    End If
    
    Mp3Play.Authorize "LightBringer", "1441658209"  'MP3控件注册
    Mp3Play.SetErrorMode 1  '允许MP3控件的错误提示
    
    Bubble1 PlayMp3

    cString = GetCommandLine
    If Len(cString) > 3 And Dir(cString) <> "" Then
        ReDim cFileNameList(1)
        ReDim cFilePathList(1)
        
        cFileName = ""
        cFilePath = ""

        File_NamePath Trim(cString), cFileName, cFilePath
        cFileNameList(1) = cFileName
        cFilePathList(1) = cFilePath
        
        bFileList = True
        
        cPlayMessage = "初始化"
        Mp3Play_ThreadEnded
        Image1_Click (2)
    Else
        cPlayMessage = "初始化"
        Mp3Play_ThreadEnded
    End If
        
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
       
    Dim msg As Long
    Dim sFilter As String
    Dim lngReturnValue As Long
    
    If Button = 1 Then
        ReleaseCapture
        lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
    
    If FormLoaded(frmAbout) = True Or FormLoaded(MList95) = True Then      '列表(表单)正在显示，退出
        Exit Sub
    End If
    
    msg = X / Screen.TwipsPerPixelX
    
    Select Case msg
        Case WM_LBUTTONUP
            If bMinimizeFlag = True Then
                Shell_NotifyIcon NIM_DELETE, nid
                'Me.Show
                'Bubble2 PlayMp3
                PhaseInForm Me
            End If
            
        Case WM_LBUTTONDBLCLK
        Case WM_RBUTTONDOWN
              'Dim ToolTipString As String
              'ToolTipString = InputBox("Enter the new ToolTip:", "Change ToolTip")
              'If ToolTipString <> "" Then
              '   nid.szTip = ToolTipString & vbNullChar
              '   Shell_NotifyIcon NIM_MODIFY, nid
              'End If
            
            Me.PopupMenu Menu
            
        Case WM_RBUTTONUP
            
        Case WM_RBUTTONDBLCLK
'               CommDial.DialogTitle = "Select an Icon"
'               sFilter = "Icon Files (*.ico)|*.ico"
'                sFilter = sFilter & "|All Files (*.*)|*.*"
'                CommDial.Filter = sFilter
'                CommDial.ShowOpen
'                If CommDial.filename <> "" Then
'                    Me.Icon = LoadPicture(CommDial.filename)
'                    nid.hIcon = Me.Icon
'                    Shell_NotifyIcon NIM_MODIFY, nid
'                End If
    End Select
    
    Line_Move 0, False  '隐藏所有按钮
    Select Case bVolumeFlag '显示当前声道状态
        Case 0
            Label1.Caption = "立体声"
        Case -1
            Label1.Caption = "左声道"
        Case 1
            Label1.Caption = "右声道"
    End Select
    
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer, j As Integer
    Dim nCount As Integer
    Dim bSearchFlag As Boolean
    Dim cString As String
    Dim cFileName As String
    Dim cFilePath As String
    
    If bPauseFileFlag = True Then
        Exit Sub
    End If

    If Data.GetFormat(vbCFFiles) Then
        j = 0
        For i = 1 To Data.Files.Count
            If Len(Trim(Data.Files(i))) > 7 And InStr(1, Trim(Data.Files(i)), ".mp", 1) > 0 Then    '此文件是音乐文件
                j = j + 1
            End If
        Next i
        
        If j > 0 Then
            ReDim cFileNameList(j)
            ReDim cFilePathList(j)
            
            j = 1
            
            For i = 1 To Data.Files.Count
                If Len(Trim(Data.Files(i))) > 7 And InStr(1, Trim(Data.Files(i)), ".mp", 1) > 0 Then    '此文件是音乐文件
                    cFileName = ""
                    cFilePath = ""
                    
                    File_NamePath Trim(Data.Files(i)), cFileName, cFilePath
                    
                    cFileNameList(j) = cFileName
                    cFilePathList(j) = cFilePath
                    
                    j = j + 1
                End If
            Next i
                       
            cPlayMessage = "列表改变"
            Mp3Play.Close
            
            If bPlayFileFlag = False Then
                Mp3Play_ThreadEnded
            End If
            
        End If
    End If
    
End Sub

Private Sub Image1_Click(Index As Integer)

On Error GoTo error_handle
    
    Dim nValues As Integer
    Dim cString As String
    
    Line_Click True
    Timer2.Enabled = True
    
    Select Case Index
        Case 0
            If bOpenFileFlag = True Then    '文件已打开
                If bPauseFileFlag = True Then   '已经播放但被暂停
                    Mp3Play.Play
                    bPauseFileFlag = False
                    cPlayMessage = "关闭"
                    Mp3Play.Stop
                Else
                    If bPlayFileFlag = True Then    '正在播放
                        cPlayMessage = "关闭"
                        Mp3Play.Stop
                    End If
                End If
            End If
        Case 1
            If bPlayFileFlag = True Then
                Mp3Play.Pause
                bPauseFileFlag = True
                bPlayFileFlag = False
                ErrorLabel.Caption = "共选择了" & UBound(cFileNameList) & "个文件 暂停播放第" & nPlayFileCount & "个文件：" & _
                    cFileNameList(nPlayFileCount)
            End If
        Case 2
            If bOpenFileFlag = True And bPlayFileFlag = False Then   '已经打开但尚未播放
                
                ErrorLabel.Caption = "共选择了" & UBound(cFileNameList) & "个文件 正在播放第" & nPlayFileCount & "个文件：" & _
                    cFileNameList(nPlayFileCount)
                nValues = Int(Mp3Play.TotalTime / 1000)
                Label5.Caption = "文件长度：" & Int(nValues / 60) & "分" & nValues Mod 60 & "秒"
                Label5.Caption = Label5.Caption & " 帧数：" & Mp3Play.FrameCount & " 采样："
                Label5.Caption = Label5.Caption & Int(Mp3Play.BitRate / 1000) & "K"
                Label5.Caption = Label5.Caption & " 音频：" & Int(Mp3Play.SampleFrequency / 1000) & "K"
                Mp3Play.Play    '开始播放
                
                nid.hIcon = Image2.Picture
                Shell_NotifyIcon NIM_MODIFY, nid

                bPlayFileFlag = True
                bPauseFileFlag = False
                cPlayMessage = "播放"
            End If
        Case 3  '后退
            If bPlayFileFlag = True And nRepeatTime = 0 Then
                If nFrameCount - 800 >= 1 Then  '未退到文件头
                    nRepeatTime = 8888
                    Mp3Play.Seek nFrameCount - 800  '后退800桢
                    Timer4.Enabled = True
                End If
            End If
        Case 4  '快进
            If bPlayFileFlag = True And nRepeatTime = 0 Then
                If nFrameCount + 800 <= Mp3Play.FrameCount Then '未到文件尾
                    nRepeatTime = 8888
                    Mp3Play.Seek nFrameCount + 800
                    Timer4.Enabled = True
                End If
            End If
        Case 5  '上一个文件
            If bOpenFileFlag = True Then    '文件已经打开
                If bPauseFileFlag = True Then   '已经播放但被暂停
                    Mp3Play.Play
                    bPauseFileFlag = False
                    cPlayMessage = "上一个"
                    Mp3Play.Stop
                Else
                    If bPlayFileFlag = True Then
                        cPlayMessage = "上一个" '正在播放
                        Mp3Play.Stop
                    Else
                        cPlayMessage = "上一个" '虽然已经打开，但是并未播放
                        Mp3Play.Close
                        Mp3Play_ThreadEnded
                    End If
                End If
            End If
        Case 6  '下一个文件
            If bOpenFileFlag = True Then    '文件已经打开
                If bPauseFileFlag = True Then   '已经播放但被暂停
                    Mp3Play.Play
                    bPauseFileFlag = False
                    cPlayMessage = "下一个"
                    Mp3Play.Stop
                Else
                    If bPlayFileFlag = True Then
                        cPlayMessage = "下一个" '正在播放
                        Mp3Play.Stop
                    Else
                        cPlayMessage = "下一个" '虽然已经打开，但是并未播放
                        Mp3Play.Close
                        Mp3Play_ThreadEnded
                    End If
                End If
            End If
        Case 7  '退出
            Randomize   '产生0-1之间的随机数
            Call PhaseOutForm(Int((1 - 0 + 1) * Rnd + 0), Me)
            End
        Case 8  '循环单首
            If bRepeatFlag = -1 Then    '取消循环
                bRepeatFlag = 0
                Image4(0).Visible = True    '显示不循环图标
                Image4(1).Visible = False
                Image4(2).Visible = False
            Else    '设置循环标志
                bRepeatFlag = -1
                Image4(0).Visible = False
                Image4(1).Visible = True    '显示循环图标
                Image4(2).Visible = False
            End If
        
        Case 9  '循环所有
            If bRepeatFlag = 1 Then '取消循环
                bRepeatFlag = 0
                Image4(0).Visible = True    '显示不循环图标
                Image4(1).Visible = False
                Image4(2).Visible = False
            Else    '设置循环标志
                bRepeatFlag = 1
                Image4(0).Visible = False
                Image4(1).Visible = False