这个程序实在不好用

[ganbaba]

就在CSDN文档区里的这个放MP3程序,我看网上也有很多地方都有,但这个程序实在不好用,有很多BUG
希望高手能帮助改改

利用API函数[mciSendString]可以轻松实现MP3音乐文件的播放。下面这段程序实现了MP3播放的大部分常规操作，对其稍加修改，做一个100KB大小的MP3播放器轻而易举
启动VB程序，在窗体上放置6个命令按钮，三个标签，一个公用对话框、一个进度条、一个状态栏和一个计时器，窗本的布置请参考附图

按钮"Open MP3 File"是用来打开对话框选择MP3文件，其他5个按钮分别为Play(播放)、Pause(暂停)、Stopplay(停止播放)、Back(向后跳跃)、Prew(向前跳跃)。Label1用来表示歌曲当前时间；label2放在时度条的最左边，Caption属性为"00：00"；lable3放在时度条的右边，用来表示歌曲总长。

下面就可以编写代码了。首先在窗体的"通用声明"部分声明函数
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

Dim mfn As String

下面就是各个对象的代码了：
Private Sub Form_load()
mfn=""
play.Enabled=False
pause.Enabled=False
Stopplay.Enabled=False
back.Enabled=False
prew.Enabled=False
Timer1.Enabled=False
Timer1.Interval=500
End Sub

Private Sub open_Click()
On Error Goto err
With CommonDialog1
.CancelError=True
.Filter="音乐文件|*.mp3;*.wav;*.mid"
.Flags=cdlOFNNoChangeDir And cdlOFNPathMustExist
.Action=1
stopplay_Click '停止按钮同时可以设备初始化
mfn=.FileName '这个程序中文件名一定不能带空格
Form1.Caption=.FileName
play.Enabled=True
End With
play_Click
Exit Sub
err:
End Sub

Private Sub play_Click()
On Error Resume Next
Dim t As Long
t=mciSendString("open " + mfn,0&,0,0) 'Open后边的空格一定不能丢
Dim ret As String * 128
t=mciSendString("status " + mfn + " length",ret,128,0)
'显示歌曲总长
ret=Left(ret,8)
If ret<>"" Then
ProgressBar1.Min=0
ProgressBar1.Max=Val(ret)
Label3.Caption=gettime(Val(ret))
End If
play.Enabled=False
pause.Enabled=True
stopplay.Enabled=True
back.Enabled=True
prew.Enabled=True
t=mciSendString("status " + mfn +" mode",ret,128,0)
'得到设备的当前状态，是播放还是暂停等等
ret=Left(ret,8)
StatusBar1.Panels(1).text=ret
'在状态栏显示播放状态
t=mciSendString("play " + mfn + " form " + Str(ProgressBar1.Value),0&,0,0)
'开始播放
Timer1.Enabled=True
End Sub

Private Sub pause_Click()
t%=mciSendString("pause " + mfn,0&,0,0)
'发出暂停的命令
play.Enable=True
pause.Enabled=False
stopplay.Enabled=True
back.Enabled=False
prew.Enabled=False
End Sub

Private Sub stopplay_Click()
t%=mciSendString("stop " + mfn,0&,0,0)
t%=mciSendString("close " + mfn,0&,0,0)
'停止播放
play.Enabled=True
pause.Enabled=False
stopplay.Enabled=False
back.Enabled=False
prew.Enabled=False
End Sub

Private Sub back_Click()
t%=mciSendString("play " + mfn + " from " + Str(ProgressBar1.Value-(ProgressBar1.Max\10)),0&,0,0) '向后跳一小段再播放
End Sub

Private Sub prew_Click()
t%=mciSendString("play " + mfn + " from " + Stri(ProgressBar1.Value+(ProgressBar1.Max\10)),0&,0,0) '向前跳一小段再播放
End Sub

Private Sub Timer1_Timer()
Dim t As Long
Dim ret As String * 128
t=mciSendString("status " + mfn + " position",ret,0,0)
'得到当前播放位置
ret=left(ret,8)
ProgressBar1.Value=Val(ret)
Label1.Caption=gettime(Val(ret))
'显示歌曲当前时间
If ProgressBar1.Value=ProgressBar1.Max Then
stopplay_Click
End If
t=mciSendString("status " + mfn + " mode",ret,128,0)
ret=Left(ret,8)
StatusBar1.Panels(1).Text=ret
End Sub

Private Sub Form_Unload(Cacel As Integer)
t%=mciSendString("stop " + mfn,0&,0,0)
t%=mciSendString("close " + mfn,0&,0,0)
End Sub

Private Function Gettime(position As Long) As String
'这个函数的功能是把以长整型表示的时间转换为电子钟式的"**:**"
Dim min,sec
min=position/1000
min=min/60
sec=min-Int(min)
min=Int(min)
sec=60 * sec / 100
sec=Int(sec * 100)
gettime=Str(min) + ":" + Str(sec)
End Function

图中5个控制按钮，其实是把字体设为"Webdings"，让它们的Caption属性分别为"4" ";" "<" "7" "8"
就可以了

[笨狗先飞]

这是利用这个api做的一个类，你可以在这个基础上扩充的，保存成一个.cls文件就行了
================================================================================
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Mmedia"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'-----------------------------------------------------
' Name : MMedia.cls
' Author : Peter Wright, For BG2VB4 & BG2VB5
'
' Notes : A multimedia class, which when turned
' : into an object lets you load and play
' : multimedia files, such as sound and
' : video.
'-----------------------------------------------------

' -=-=-=- PROPERTIES -=-=-=-
' Filename Determines the name of the current file
' Length The length of the file (Read Only)
' Position The current position through the file
' Status The current status of the object (Read Only)
' Wait True/False...tells VB to wait until play done

' -=-=-=- METHODS -=-=-=-=-
' mmOpen <Filename> Opens the requested filename
' mmClose Closes the current file
' mmPause Pauses playback of the current file
' mmStop Stops playback ready for closedown
' mmSeek <Position> Seeks to a position in the file
' mmPlay Plays the open file

'-------------------------------------------------------------
' NOTES
' -----
'
' Open a file, then play it. Pause it in response to a request
' from the user. Stop if you intend to seek to the start and
' play again. Close when you no longer want to play the file
'--------------------------------------------------------------

Private sAlias As String ' Used internally to give an alias name to
' the multimedia resource

Private sFileName As String ' Holds the filename internally
Private nLength As Single ' Holds the length of the filename
' internally
Private nPosition As Single ' Holds the current position internally
Private sStatus As String ' Holds the current status as a string
Private bWait As Boolean ' Determines if VB should wait until play
' is complete before returning.

[笨狗先飞]

'------------ API DECLARATIONS -------------
'note that this is all one code line:
Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

Public Sub mmOpen(ByVal sTheFile As String)

' Declare a variable to hold the value returned by mciSendString
Dim nReturn As Long

' Declare a string variable to hold the file type
Dim sType As String

' Opens the specified multimedia file, and closes any
' other that may be open
If sAlias <> "" Then
mmClose
End If

' Determine the type of file from the file extension
Select Case UCase$(Right$(sTheFile, 3))
Case "WAV"
sType = "Waveaudio"
Case "AVI"
sType = "AviVideo"
Case "MID"
sType = "Sequencer"
Case Else
' If the file extension is not known then exit the subroutine
Exit Sub
End Select
sAlias = Right$(sTheFile, 3) & Minute(Now)

' At this point there is no file open, and we have determined the
' file type. Now would be a good time to open the new file.
' Note: if the name contains a space we have to enclose it in quotes
If InStr(sTheFile, " ") Then sTheFile = Chr(34) & sTheFile & Chr(34)
nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _
& " TYPE " & sType & " wait", "", 0, 0)
End Sub

Public Sub mmClose()
' Closes the currently opened multimedia file

' Declare a variable to hold the return value from the mciSendString
' command
Dim nReturn As Long

' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub

nReturn = mciSendString("Close " & sAlias, "", 0, 0)
sAlias = ""
sFileName = ""

End Sub

Public Sub mmPause()
' Pause playback of the file

' Declare a variable to hold the return value from the mciSendString
' command
Dim nReturn As Long

' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub

nReturn = mciSendString("Pause " & sAlias, "", 0, 0)

End Sub

Public Sub mmPlay()
' Plays the currently open file, from the current position

' Declare a variable to hold the return value from the mciSendString
' command
Dim nReturn As Long

' If there is no file currently open, then exit the routine
If sAlias = "" Then Exit Sub

' Now play the file
If bWait Then
nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
Else
nReturn = mciSendString("Play " & sAlias, "", 0, 0)
End If
End Sub

Public Sub mmStop()
' Stop using a file totally, be it playing or whatever

' Declare a variable to hold the return value from mciSendString
Dim nReturn As Long

' If there is no file currently open then exit the subroutine
If sAlias = "" Then Exit Sub

nReturn = mciSendString("Stop " & sAlias, "", 0, 0)

End Sub

Public Sub mmSeek(ByVal nPosition As Single)
' Seeks to a specific position within the file

' Declare a variable to hold the return value from the mciSendString
' function
Dim nReturn As Long

nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)

End Sub

Property Get FileName() As String
' Routine to return a value when the programmer asks the
' object for the value of its Filename property
FileName = sFileName
End Property

Property Let FileName(ByVal sTheFile As String)
' Routine to set the value of the filename property, should the programmer
' wish to do so. This implies that the programmer actually wants to open
' a file as well so control is passed to the mmOpen routine
mmOpen sTheFile
End Property

Property Get Wait() As Boolean
' Routine to return the value of the object's wait property.
Wait = bWait
End Property

Property Let Wait(bWaitValue As Boolean)
' Routine to set the value of the object's wait property
bWait = bWaitValue
End Property

Property Get Length() As Single
' Routine to return the length of the currently opened multimedia file

' Declare a variable to hold the return value from the mciSendString
Dim nReturn As Long, nLength As Integer

' Declare a string to hold the returned length from the mci Status call
Dim sLength As String * 255

' If there is no file open then return 0
If sAlias = "" Then
Length = 0
Exit Property
End If

nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)
nLength = InStr(sLength, Chr$(0))
Length = Val(Left$(sLength, nLength - 1))
End Property

Property Let Position(ByVal nPosition As Single)
' Sets the Position property effectively by seeking
mmSeek nPosition
End Property

Property Get Position() As Single
' Returns the current position in the file

' Declare a variable to hold the return value from mciSendString
Dim nReturn As Integer, nLength As Integer

' Declare a variable to hold the position returned
' by the mci Status position command
Dim sPosition As String * 255

' If there is no file currently opened then exit the subroutine
If sAlias = "" Then Exit Property

' Get the position and return
nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
nLength = InStr(sPosition, Chr$(0))
Position = Val(Left$(sPosition, nLength - 1))

End Property

Property Get Status() As String
' Returns the playback/record status of the current file

' Declare a variable to hold the return value from mciSendString
Dim nReturn As Integer, nLength As Integer

' Declare a variable to hold the return string from mciSendString
Dim sStatus As String * 255

' If there is no file currently opened, then exit the subroutine
If sAlias = "" Then Exit Property

nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)

nLength = InStr(sStatus, Chr$(0))
Status = Left$(sStatus, nLength - 1)

End Property

[ganbaba]

不懂类模块

[ganbaba]

顶!高手捏?

[ganbaba]

顶!