--- Soumis par Dev Ashish---
Faire jouer des fichiers MIDI/Avi/Wav.
(Q) Comment faire jouer des fichiers de type midi, wave ou de type avi depuis Access?
(A) Utiliser les fonctions suivantes. S'assurer de bien inclure l'extension correspondante au type de fichier.
'****************** Code Start *********************' Public Const pcsSYNC = 0 ' on désire attendre jusqu'à ce que ce soit terminé Public Const pcsASYNC = 1 ' on ne désire pas attendre la fin pour poursuivre l'exécution du code Public Const pcsNODEFAULT = 2 ' ne joue aucun son si le son n'existe pas Public Const pcsLOOP = 8 ' joue en boucle infinie (jusqu'à la prochaine demande d'exécution) Public Const pcsNOSTOP = 16 ' ne pas interrompre un son qui a commencé '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 'DOIT utiliser un fichier AVEC son extension 'Supporte les types: Wav, AVI, MID 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) 'Arrête le 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 'Trouve le dernier \ 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 ' Traduire l'erreur numérique en texte 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 *********************'