Music midi en boucle

Question

Bonjour ! voila j'ai un module qui me sert a play une musique midi :



--------------------------------------------------------------------------------------



Public 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

Public Declare Function sndPlaySound Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
As Long



Public Const SND_SYNC = &H0

Public Const SND_ASYNC = &H1

Public Const SND_NODEFAULT = &H2

Public Const SND_MEMORY = &H4

Public Const SND_LOOP = &H8

Public Const SND_NOSTOP = &H10



Public Sub PlayMidi(Song As String)

Dim i As Long

    

    i = mciSendString("close all", 0, 0, 0)

    i = mciSendString("open " & Song & " type sequencer alias background", 0, 0, 0)

    i = mciSendString("play background notify", 0, 0, frmMirage.hwnd)

End Sub



Public Sub StopMidi()

Dim i As Long

  

    i = mciSendString("close all", 0, 0, 0)

End Sub



Public Sub PlaySound(Sound As String)

    Call sndPlaySound(App.Path & "" & Sound, SND_ASYNC Or SND_NOSTOP)

End Sub



--------------------------------------------------------------------------------------



Est-ce que ya possibilit&#233; avec ce modul de le changer pour faire un LOOP avec la music.



Bref la musique en boucle ?



Merci a vous ! moi je continue de mon coter a faire mes recherche ! 


kakenette

spaa05 · Answer

bonjour pour jouer un midi en boucle voici un code Option Explicit 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 mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _ (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long 'Dim Multiple65 As Integer 'Dim Reste As Long Dim taille As Long Dim enCours As Boolean Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 If enCours = False Then Dim MIDIPath As String, errstring As String * 200, x As Long Dim tailleStr As String * 40 Dim pos As Long, posStr As String * 40 MIDIPath = App.Path & "\son1.mid" enCours = True ' ouvrir x = mciSendString("open " & MIDIPath & " Type sequencer Alias MLfile wait", _ 0&, 0, 0) If x <> 0 Then ErrmciSendString x, errstring Exit Sub End If ' la taille en millisecondes x = mciSendString("set MLfile time format ms ", 0&, 0, 0) If x <> 0 Then ErrmciSendString x, errstring Exit Sub End If x = mciSendString("status MLfile length", tailleStr, Len(tailleStr), 0) If x <> 0 Then ErrmciSendString x, errstring Exit Sub End If taille = CLng(tailleStr) x = mciSendString("play MLfile ", 0&, 0, 0) If x <> 0 Then ErrmciSendString x, errstring Exit Sub End If Debug.Print "taille : " & taille Debug.Print "début du .mid : " & Timer * 100 'Déclencher le Timer pour 150 ms avant la fin du .mid ' Multiple65 = Int(taille / 65535) ' Reste = taille Mod 65535 ' If Multiple65 = 0 Then Timer1.Interval = taille - 500 ' Else ' Timer1.Interval = 65535 ' End If Timer1.Enabled = True End If Case 1 x = mciSendString("stop MLfile", 0&, 0, 0) x = mciSendString("close MLfile", 0&, 0, 0) enCours = False Case 2 x = mciSendString("close all", 0&, 0, 0) Unload Me End Select End Sub Private Function ErrmciSendString(ByVal msgErr As Long, ByVal errstring As String) mciGetErrorString msgErr, errstring, Len(errstring) MsgBox Left$(errstring, InStr(errstring, vbNullChar)), vbCritical, "Erreur mciSendString" End Function Private Sub Form_Load() enCours = False End Sub Private Sub Timer1_Timer() 'exécute la boucle de temporisation Static tim As Integer Dim pos As Long, posStr As String * 40, errstring As String * 200 Dim x As Long Select Case tim ' Case Is < Multiple65 ' tim = tim + 1 ' If tim = Multiple65 Then ' Timer1.Interval = Reste - 500 ' End If Case 0 If enCours = True Then Debug.Print "Boucle : " & Timer * 100 Timer1.Interval = 500 'temporisation jusqu'à la fin du morceau (~ 100 ms) Do x = mciSendString("status MLfile position", posStr, Len(posStr), 0) If x <> 0 Then Exit Sub pos = CLng(posStr) DoEvents Loop While pos <> taille 'jouer x = mciSendString("play MLfile from 0", 0&, 0, 0) Debug.Print "début : " & Timer * 100 If x <> 0 Then ErrmciSendString x, errstring Exit Sub End If End If ' tim = tim + 1 Case 1 ' If Multiple65 = 0 Then Timer1.Interval = taille - 500 ' Else ' Timer1.Interval = 65535 ' End If ' tim = 0 End Select tim = Abs(tim - 1) End Sub

spaa05 · Answer

3 bouton indexer 0play 1stop 2quit
1 timer

Music midi en boucle

2 réponses

Discussions similaires