前些天在QQ裡聼到個網友說他用MCI播放MP3會有破聲，偶才想起自己也曾用過
mciSendString，就將牠翻了出來。
不過功能比較單調，衹實現了播放和取歌曲的播放時間長度
需要軟件在後臺播放音樂的朋友不妨拿去用用。
Option Explicit
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'文件名：clsMP3Player
'功能 ：播放MP3
'作者 ：money
'E-mail：2258773@163.com
'QQ ：447295048
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrRetumString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Event PlayTime(ByVal ltime As Long) '播放了多少秒
Public Event PlayEnd() '播放结束
Public Enum PLAYER_STATUS
CLOSED = 0
Playing = 1
Pauseing = 2
End Enum
Private mp3file As String '播放的文件
Private time分 As Long '该mp3的时间长度，分
Private time秒 As Long '该mp3的时间长度，秒
Private IsPlay As Boolean '是否播放
Private Play_Status As PLAYER_STATUS '播放器状态
Private lngAllTime As Long '时间总长度,以秒计
Public Function PLAY() As Boolean
On Error GoTo ErrProc
Dim ret As Long
'如果mp3file没有设置或文件不存在
If Len(Dir(mp3file)) < 3 Then GoTo ErrProc
'如果己设值就先关闭
If IsPlay Then
ret = mciSendString("Close " & mp3file, 0&, 0, 0)
If ret Then GoTo ErrProc
End If
'打开
ret = mciSendString("Open " & mp3file, 0&, 0, 0)
Call GetTimeLenght
If ret Then GoTo ErrProc
'播放
ret = mciSendString("play " + mp3file, 0&, 0, 0)
If ret Then GoTo ErrProc
IsPlay = True
PLAY = True
Play_Status = Playing
Exit Function
ErrProc:
ret = mciSendString("Close " & mp3file, 0&, 0, 0)
IsPlay = False
PLAY = False
Play_Status = CLOSED
End Function
'暂停
Public Function PAUSE(ByVal Status As Boolean)
Dim ret As Long
If IsPlay Then
'为真就暂停
If Status Then
ret = mciSendString("Stop " & mp3file, 0&, 0, 0)
Play_Status = Pauseing
Else '否则就接着播放
ret = mciSendString("Play " & mp3file, 0&, 0, 0)
Play_Status = Playing
End If
End If
End Function
'取播放状态
Property Get PlayStatus() As PLAYER_STATUS
PlayStatus = Play_Status
End Property
'设值
Property Let FileName(ByVal szMP3File As String)
mp3file = szMP3File
End Property
'取值
Property Get FileName() As String
szMP3File = mp3file
End Property
'取时间长度
Private Sub GetTimeLenght()
Dim ret As Long
Dim tmpLen As String * 128
Dim tmpLenght As Long
On Error GoTo ErrProc
ret = mciSendString("status " & mp3file & " length", tmpLen, 128, 0)
If ret Then GoTo ErrProc
tmpLenght = CLng(tmpLen)
time分 = Int(tmpLenght \ 60000)
time秒 = (tmpLenght \ 1000) Mod 60
lngAllTime = GetAllTime(time分, time秒)
Exit Sub
ErrProc:
tmpLenght = 0
time秒 = 0
time分 = 0
End Sub
Private Function GetAllTime(ByVal min As Long, ByVal sec As Long) As Long
GetAllTime = min * 60 + sec
End Function
'取秒
Property Get Second() As Long
Second = time秒
End Property
'取分
Property Get Minute() As Long
Minute = time分
End Property
'播放时间
Property Get AllTime() As Long
AllTime = lngAllTime
End Property
'关闭
Public Sub CloseFile()
Call mciSendString("Close " & mp3file, 0&, 0, 0)
Play_Status = CLOSED
End Sub
Private Sub Class_Terminate()
Call CloseFile
End Sub
'-------------------------End Class-------------------------
'例程：
'-----------------Forms----------------------------
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 2715
ClientLeft = 0
ClientTop = 0
ClientWidth = 4275
LinkTopic = "Form1"
Picture = "Form1.frx":0000
ScaleHeight = 2715
ScaleWidth = 4275
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 2220
Top = 1770
End
Begin VB.HScrollBar HSV
Height = 180
Left = 165
TabIndex = 7
Top = 1635
Width = 3975
End
Begin VB.CommandButton Command3
Caption = "Close"
Height = 420
Left = 2880
TabIndex = 3
Top = 1935
Width = 1230
End
Begin VB.CommandButton Command2
Caption = "Pause"
Height = 420
Left = 2970
TabIndex = 2
Top = 1065
Width = 1230
End
Begin VB.CommandButton Command1
Caption = "Play"
Height = 420
Left = 2820
TabIndex = 1
Top = 480
Width = 1230
End
Begin VB.Label Label7
Caption = "Label7"
Height = 495
Left = 1785
TabIndex = 10
Top = 1920
Width = 540
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "00:00"
Height = 180
Left = 1920
TabIndex = 9
Top = 1350
Width = 450
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "00:00"
Height = 180
Left = 1290
TabIndex = 8
Top = 765
Width = 450
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "剩余时间："
Height = 180
Left = 300
TabIndex = 6
Top = 1170
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "己放时间："
Height = 180
Left = 270
TabIndex = 5
Top = 720
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "时间长度："
Height = 180
Left = 270
TabIndex = 4
Top = 345
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "00:00"
Height = 180
Left = 1965
TabIndex = 0
Top = 1005
Width = 450
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private MP3Player As New clsMP3Player
Private AllTime As Long
Dim mfn As String
Private Sub Command1_Click()
With MP3Player
.FileName = mfn
.PLAY
AllTime = .AllTime
Timer1.Enabled = True
HSV.Max = AllTime
HSV.min = 1
Label1.Caption = Format(.Minute, "00") & ":" & Format(.Second, "00")
End With
End Sub
Private Sub Command2_Click()
Static Status As Boolean
Status = Not Status
MP3Player.PAUSE Status
Timer1.Enabled = Not Status
End Sub
Private Sub Command3_Click()
MP3Player.CloseFile
End Sub
Private Sub Form_Load()
mfn = "E:\TEST\不再犹豫.mp3"
End Sub
Private Sub Form_Unload(Cancel As Integer)
MP3Player.CloseFile
Set MP3Player = Nothing
End Sub
Private Sub HScroll1_Change()
If HSV.Value < 10 Then Exit Sub
MP3Player.GotoTime HScroll1.Value
End Sub
Private Sub Timer1_Timer()
If AllTime <= 0 Then
MP3Player.CloseFile
Timer1.Enabled = False
Exit Sub
End If
AllTime = AllTime - 1
Label5.Caption = Format(Int((MP3Player.AllTime - AllTime) \ 60), "00") & ":" & Format(Int((MP3Player.AllTime - AllTime) Mod 60), "00")
Label6.Caption = Format(Int(AllTime \ 60), "00") & ":" & Format(Int(AllTime Mod 60), "00")
HSV.Value = MP3Player.AllTime - AllTime
End Sub
'------------------------------End Forms---------------------------
怪事，明明我用的是VB6.0，怎麽.frm標的是VB5.0呢
本文来源：http://blog.csdn.net/lorl2/archive/2007/08/25/1759027.aspx
站内文章搜索
