这个程序实在不好用

Question

就在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 longDim 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate Sub back_Click()
t%=mciSendString("play " + mfn + " from " + Str(ProgressBar1.Value-(ProgressBar1.Max\10)),0&,0,0) '向后跳一小段再播放
End SubPrivate Sub prew_Click()
t%=mciSendString("play " + mfn + " from " + Stri(ProgressBar1.Value+(ProgressBar1.Max\10)),0&,0,0) '向前跳一小段再播放
End SubPrivate 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 SubPrivate Sub Form_Unload(Cacel As Integer)
t%=mciSendString("stop " + mfn,0&,0,0)
t%=mciSendString("close " + mfn,0&,0,0)
End SubPrivate 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"
就可以了

Answer 1

这是利用这个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 resourcePrivate 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.

Answer 2

'------------ 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 LongPublic 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 SubPublic 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 SubPublic 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 SubPublic 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 SubPublic 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 SubPublic 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 SubProperty 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 PropertyProperty 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 PropertyProperty Get Wait() As Boolean
' Routine to return the value of the object's wait property.
   Wait = bWait
End PropertyProperty Let Wait(bWaitValue As Boolean)
' Routine to set the value of the object's wait property
   bWait = bWaitValue
End PropertyProperty 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 PropertyProperty Let Position(ByVal nPosition As Single)
' Sets the Position property effectively by seeking
    mmSeek nPosition
End PropertyProperty 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 PropertyProperty 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