如何在access中播放MIDI、AVI、WAV文件
时 间:2007-05-15 00:00:00
作 者:黄海 ID:32 城市:苏州
摘 要:在ACCESS中播放MIDI、AVI、WAV文件的详细代码
正 文:
'****************** Code Start *********************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Public Const pcsSYNC = 0 ' wait until sound is finished playing
Public Const pcsASYNC = 1 ' don't wait for finish
Public Const pcsNODEFAULT = 2 ' play no default sound if sound doesn't exist
Public Const pcsLOOP = 8 ' play sound in an infinite loop (until next apiPlaySound)
Public Const pcsNOSTOP = 16 ' don't interrupt a playing sound
'Sound APIs
Private Declare Function apiPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'AVI APIs
Private Declare Function apimciSendString 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 apimciGetErrorString Lib "Winmm.dll" _
Alias "mciGetErrorStringA" (ByVal dwError As Long, _
ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Function fPlayStuff(ByVal strFilename As String, _
Optional intPlayMode As Integer) As Long
'MUST pass a filename _with_ extension
'Supports Wav, AVI, MID type files
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "wav":
If Not IsMissing(intPlayMode) Then
lngRet = apiPlaySound(strFilename, intPlayMode)
Else
MsgBox "Must specify play mode."
Exit Function
End If
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("play " & strFilename, strTemp, 255, 0)
End Select
fPlayStuff = lngRet
End Function
Function fStopStuff(ByVal strFilename As String)
'Stops a multimedia playback
Dim lngRet As Long
Dim strTemp As String
Select Case LCase(fGetFileExt(strFilename))
Case "Wav":
lngRet = apiPlaySound(0, pcsASYNC)
Case "avi", "mid":
strTemp = String$(256, 0)
lngRet = apimciSendString("stop " & strFilename, strTemp, 255, 0)
End Select
fStopStuff = lngRet
End Function
Private Function fGetFileExt(ByVal strFullPath As String) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Find the last \
If Mid$(strFullPath, intPos, 1) = "." Then
fGetFileExt = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function
Function fGetError(ByVal lngErrNum As Long) As String
' Translate the error code to a string
Dim lngx As Long
Dim strErr As String
strErr = String$(256, 0)
lngx = apimciGetErrorString(lngErrNum, strErr, 255)
strErr = Left$(strErr, Len(strErr) - 1)
fGetError = strErr
End Function
Function fatest()
Dim a As Long
a = fPlayStuff("C:\winnt\clock.avi")
'a = fStopStuff("C:\winnt\clock.avi")
End Function
'****************** Code End *********************
'特别说明:本文原创作者:Dev Ashish
Access软件网QQ交流群 (群号:483923997) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access窗体导出PDF】...(04.08)
- 【Access窗体导出PDF】...(04.07)
- Access两种方式实现即时更...(03.01)
- Access隐藏与显示lacc...(01.12)
- 【Access高效办公】将每个...(12.23)
- Access21点游戏源代码(12.13)
- 【Access窗体导出Exce...(11.15)
- 【Access开发】Acces...(11.14)
- 通过Access宏录入数据到选...(11.10)
学习心得
最新文章
- ACCESS精华集锦资料.CHM(04.25)
- Access VBA语句If Me...(04.24)
- 【Access修改记录示例】编辑选...(04.22)
- 【Access表名称命名建议】将A...(04.20)
- Access学习笔记--用Acce...(04.19)
- 【Access重复项查询示例】将A...(04.17)
- Access快速开发平台企业版--...(04.16)
- 【Access模块示例】通过模块代...(04.15)
- Access查询里面分组合计功能添...(04.13)
- 【Access删除查询】删除数字最...(04.12)