'This project needs a Common Dialog box, named 'CDBox'
'  (To add the Common Dialog Box to your tools menu, go to Project->Components (or press CTRL-T)
'   and select Microsoft Common Dialog control)
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
Dim Alias As String
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Const PlayTime = 10
    'Set the common dialog box' title
    CDBox.DialogTitle = "Choose your midi-file"
    'Set the filter
    CDBox.Filter = "Midi-files (*.mid)|*.mid"
    'Show the 'Open File'-dialog
    CDBox.ShowOpen
    'Extract an alias from the file
    Alias = Left$(CDBox.FileTitle, Len(CDBox.FileTitle) - 4)    'play midi
    R% = mciSendString("OPEN " + CDBox.filename + " TYPE SEQUENCER ALIAS " + Alias, 0&, 0, 0)
    R% = mciSendString("PLAY " + Alias + " FROM 0", 0&, 0, 0)
    R% = mciSendString("CLOSE ANIMATION", 0&, 0, 0)    'play midi for 10 secs
    t = Timer
    Do: DoEvents: Loop Until Timer > t + PlayTime    'stop midi and close it
    R% = mciSendString("OPEN " + CDBox.filename + " TYPE SEQUENCER ALIAS " + Alias, 0&, 0, 0)
    R% = mciSendString&("STOP " + Alias, 0&, 0, 0)
    R% = mciSendString&("CLOSE ANIMATION", 0&, 0, 0)
End Sub

解决方案 »

  1.   

    要用VB做多媒体程序的同志必看...      
    关键字:
    要用VB做多媒体程序的同志必看...  贴文时间
    2001-2-27 12:06:46  文章类型: 
    原作  给贴子投票  
      TrueZq    原作  出处:  
      
    Csdn上已经有好多朋友问过诸如:
     “如何播放Avi、Wave、midi文件”、:
     “谁知道用api播放avi,mpg的详细方法?要可以设定将图像放置到设定的窗体中”、
     “如何同时播放两个Wav文件”
    的问题,
    其实用一个类模块就一切搞定,不需要什么控件之类的东西
    下面这个类模块(不知从哪里找来的,好象就是CSDN),我研究后将它修改得更好用了
    将下面这个类模块存为Mmedia.cls
    '----------------------------------------------------
    Option Explicit'--------------TrueZq 最新更新2001-01-12---------------------
    '文件名:      MMedia.cls
    '说明:   :  一个多媒体类,能播放Avi、Wave、Midi文件
    '用法:
    'Dim Multimedia As New Mmedia
    'Multimedia.mmOpen "c:\test.wav"
    'Multimedia.mmPlay
    '!记住:在程序结束时,一定要用Set Multimedia=nothing释放资源!!!
    '-----------------------------------------------------' -=-=-=- 属性 -=-=-=-
    ' sFilename      当前的文件名
    ' nLength        文件长度(只读)
    ' nPosition      当前位置
    ' sStatus        当前状态(只读)
    ' bWait          True/False.决定是否等待播放完' -=-=-=- 方法 -=-=-=-=-
    ' mmOpen <Filename>   打开要播放的文件
    ' mmClose             关闭当前文件
    ' mmPause             暂停
    ' mmStop              停止 停止后可以跳到开始再次播放
    ' mmSeek <Position>   Seeks to a position in the file
    ' mmPlay              播放'--------------------------------------------------------------Private sAlias As String        '别名
    'Private hWnd As Long
    Private sFilename As String     ' 当前的文件名
    Private nLength As Single       ' 文件长度
                              
    Private nPosition As Single     ' 当前位置
    Private sStatus As String       ' 当前状态
    Private bWait As Boolean        ' 决定是否等待播放完
    Const WS_CHILD = &H40000000
    '------------ API 声明 -------------
    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'Private Declare Function GetActiveWindow Lib "USER32" () As Integer'当sTheFile是一个Avi文件时,参数hWnd指定动画在哪里播放
    '若hWnd=0,则新开一个窗口播放动画。
    '如果听不到Midi音乐,请在Windows下用媒体播放器测试一下。
    '文件名不能带空格
    Public Sub mmOpen(ByVal sTheFile As String, Optional hWnd As Long = 0)    Dim nReturn As Long
        Dim sType As String '文件类型
        Static nNum As Integer
        
        If sAlias <> "" Then '关闭开始打开的文件
            mmClose
        End If
        
        If (Dir(sTheFile) = "") Then '判断是否是一个存在的文件
            sFilename = "文件" & sTheFile & " 不存在!"
            Exit Sub
        Else
            sFilename = sTheFile
    '        nNum = nNum + 1
        End If
    '    Stop
       sAlias = sFilename '用文件名作别名,避免别名冲突!
        ' 判断文件类型
        Select Case UCase$(Right$(sTheFile, 3))
           Case "WAV"
              sType = "Waveaudio"
           Case "AVI"
              sType = "AviVideo"
            
           Case "MID"
              sType = "Sequencer"
           Case Else
              ' 未知文件格式,退出。
              Exit Sub
        End Select
        
        If sType = "AviVideo" And hWnd > 0 Then
             nReturn = mciSendString("open " & sTheFile & " ALIAS " & sAlias _
                & " TYPE AVIVideo parent " & hWnd & " style " & LTrim$(Str$(WS_CHILD)), 0&, 0, 0)
        Else
            nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _
                & " TYPE " & sType, "", 0, 0)
        End If
        
    End Sub'关闭当前打开的多媒体文件
    Public Sub mmClose()
        Dim nReturn As Long
        
        '如果没有文件打开,则退出
        If sAlias = "" Then Exit Sub
        
        nReturn = mciSendString("Close " & sAlias, "", 0, 0)
        sAlias = ""
        sFilename = ""
        
    End Sub'暂停
    Public Sub mmPause()
     
        Dim nReturn As Long
        
        If sAlias = "" Then
            Exit Sub
        ElseIf Status = "paused" Then '如果先前已经暂停了,则解除暂停
            mmPlay
        Else
            nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
        End If
        'nPosition = Position
    End Sub'播放
    Public Sub mmPlay()
       
        Dim nReturn As Long
        
        If sAlias = "" Then
            Exit Sub
        ElseIf Position = Length Then '如果已经到末尾
            mmSeek 0                  '跳到开始处
        End If
        
        
        If bWait Then
            nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
        Else
            nReturn = mciSendString("Play " & sAlias, "", 0, 0)
        End If
    End Sub'停止
    '停止后跳到开始,以便再次播放
    Public Sub mmStop()
      
        Dim nReturn As Long
       
        If sAlias = "" Then Exit Sub
        
        nReturn = mciSendString("Stop " & sAlias, "", 0, 0)
        mmSeek 0 '跳到开始位置
    End Sub'跳到指定的位置,并且处于暂停状态
    '当nPosition的值>Length 或者nPosition<0时,将忽略这次操作
    Public Sub mmSeek(ByVal nPosition As Single)
        
        Dim nReturn As Long
        nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)End Sub'方法Filename返回当前打开的文件名
    Property Get filename() As String
        filename = sFilename
    End Property'指定要播放的文件名,然后将它打开
    '对于需要指定容器的Avi文件,不要以这种方式打开。
    Property Let filename(ByVal sTheFile As String)   mmOpen sTheFile
    End Property'读取属性Wait的值
    'Msgbox Multimedia.Wait
    Property Get Wait() As Boolean
       Wait = bWait
    End Property'设置等待属性
    '用法:Multimedia.Wait=True
    Property Let Wait(bWaitValue As Boolean)   bWait = bWaitValue
    End Property'获得长度值
    Property Get Length() As Single
       
       Dim nReturn As Long, nLength As Integer   Dim sLength As String * 255
        
       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)
        mmSeek nPosition
    End Property'获取当前位置
    Property Get Position() As Single
      
       Dim nReturn As Integer, nLength As Integer
      
       Dim sPosition As String * 255   If sAlias = "" Then Exit Property
        
     
       nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
       nLength = InStr(sPosition, Chr$(0))
       Position = Val(Left$(sPosition, nLength - 1))End Property'当前打开文件的状态
    '有以下几种:playing paused stopped
    Property Get Status() As String
     
       Dim nReturn As Integer, nLength As Integer
       Dim sStatus As String * 255
           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'从头开始播放
    Public Sub mmRestart()
        Dim nReturn As Long
        
        If sAlias = "" Then Exit Sub
       
        mmSeek 0
        mmPlay
    End Sub'类的初始化
    Private Sub Class_Initialize()
    '    sAlias = "" '别名初值为空
    End Sub'关闭打开的多媒体设备
    '当该类的对象所在的窗体(或模块)卸载时,自动调用该过程
    Private Sub Class_Terminate()
        mmClose
    End Sub
    '----------------------------------------------------
    [用法]
    1、
    比如要在窗体上播放一个动画,只需3个语句就搞定。
    Dim MmAvi As New Mmedia
    MmAvi.mmOpen "G:\resource\Avi\Test.avi", Me.hWnd
    MmAvi.mmPlay2、循环播放
    Private Sub Timer1_Timer()
        Dim S As String
        S = "当前文件:" & MmAvi.filename & vbCrLf & "当前位置:" & MmAvi.Position _
             & "总长度:" & MmAvi.Length & "当前状态:" & MmAvi.Status
        Label1.Caption = S
        If MmAvi.Status = "stopped" Then MmAvi.mmRestart
    End sub3、同时播放几个文件(类型可以相同、可以不同)
    在Form1中加入Private MmWave(1) As New Mmedia
    在需要播放的地方加上:
        MmWave(0).mmOpen "G:\resource\wave\m16.wav"
        MmWave(1).mmOpen "G:\resource\wave\Welcom98.wav"
        MmWave(0).mmPlay
        MmWave(1).mmPlay
    4、将动画放入一个圆形区域播放    Dim hr As Long
        Dim usew&, useh&
        Dim MmAvi As New Mmedia    usew& = Frame1.Width / Screen.TwipsPerPixelX
        useh& = Frame1.Height / Screen.TwipsPerPixelY
        usew = useh
        hr& = CreateEllipticRgn(0, 0, usew, useh)
        Call SetWindowRgn(Frame1.hWnd, hr, True)
        MmAvi.mmOpen "G:\resource\Avi\start.avi", Frame1.hWnd
        MmAvi.mmPlay
    ………………………………