非常简单! 将下面这个类模块存为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 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
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 __________________________________ 然后在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 一切OK,有问题再问。
将下面这个类模块存为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
__________________________________
然后在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
一切OK,有问题再问。