APIs: Faire jouer des fichiers MIDI/Avi/Wav	Author(s) Dev Ashish

(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 *********************'