stopper une fonction lancée sur clic

bonjour tlm!
alors mon petit pb c que j'ai une fonction lecture qui lance la lecture de sons(créés par mon programme) sur ma carte son.
Le pb c que une foi le bouton lecture enfoncé je doit attendre la fin de la lecture de tt les son pour reprendre la main et pouvoir faire autre chose sur mon programme. Et je souhaiterai faire un bouton stop afin d'interrompre la lecture mais la je sais pas du tt comment faire puisse que je n'ai pas la main(le bouton lecture reste enfoncé et je ne pe rien faire).Je sais qu'il faut surement revoir le systeme de lecture entierement mais je sais pas ce que je pe faire aidez moi svp!!!
pour une meilleur compréhension voici le code de la fonction lecture

Sub Lecture(Index)
Dim lanote As Integer
Dim TypeSon As Integer
Dim Temps As Integer
Dim Note1 As Long
Dim Note2 As Long
Dim Note3 As Long
Dim Note4 As Long
Dim Note5 As Long
Dim Note6 As Long
Dim i As Integer

TypeSon = frmPrincipale.CboType.ListIndex
If TypeSon = -1 Then
TypeSon = 0
End If

' Ouverture du port Midi
midiOutOpen hMidiOut, 0, 0, 0, 0
' Déclaration du type de son
midiOutShortMsg hMidiOut, RGB(192, TypeSon, 127) 'Permet de generer le nombre en Hexadecimal
'Creation de la note
i = 0
While Index < IndexMax
MsgBox (Index / 5)
Temps = (1 / frmPrincipale.Txttempo(i).Text)*frmPrincipale.txttemp.Text * 10
If frmPrincipale.txtNote(Index).Text <> "" Then
lanote = 30 + frmPrincipale.txtNote(Index).Text + 24 ' calcul note
Note1 = RGB(144, lanote, 127) 'astuce generer un entier long
midiOutShortMsg hMidiOut, Note1 ' envoie note sur port MIDI
End If
Index = Index + 1
If frmPrincipale.txtNote(Index).Text <> "" Then
lanote = 30 + frmPrincipale.txtNote(Index).Text + 19 'calcule note
Note2 = RGB(144, lanote, 127) 'astuce generer entier long
midiOutShortMsg hMidiOut, Note2 ' envoie note sur port MIDI
End If
Index = Index + 1
If frmPrincipale.txtNote(Index).Text <> "" Then
lanote = 30 + frmPrincipale.txtNote(Index).Text + 15 'calcule note
Note3 = RGB(144, lanote, 127) 'astuce generer entier long
midiOutShortMsg hMidiOut, Note3 'envoie note sur port MIDI
End If
Index = Index + 1

If frmPrincipale.txtNote(Index).Text <> "" Then
lanote = 30 + frmPrincipale.txtNote(Index).Text + 10 ' on calcule la note
Note4 = RGB(144, lanote, 127) 'astuce pour generer un entier long
midiOutShortMsg hMidiOut, Note4 ' on envoie la note sur le port MIDI
End If
Index = Index + 1

If frmPrincipale.txtNote(Index).Text <> "" Then
lanote = 30 + frmPrincipale.txtNote(Index).Text + 5 ' on calcule la note
Note5 = RGB(144, lanote, 127) 'astuce pour generer un entier long
midiOutShortMsg hMidiOut, Note5 ' on envoie la note sur le port MIDI
End If
Index = Index + 1

If frmPrincipale.txtNote(Index).Text <> "" Then
lanote = 30 + frmPrincipale.txtNote(Index).Text ' on calcule la note
Note6 = RGB(144, lanote, 127) 'astuce pour generer un entier long
midiOutShortMsg hMidiOut, Note6 ' on envoie la note sur le port MIDI
End If
Index = Index + 1
i = i + 1
Sleep (Temps)
Wend
midiOutClose hMidiOut 'ferme le port midi pour arreter la note

End Sub


mailto:S0KARISS@hotmail.com

d'abord tu devrais simplifier ton propramme et faire une boucle au lieu de faire 6 fois la même chose:

dim x As Integer
dim Note As Long

For x = 1 To 6
If Frmprincipale.txtNote(Index).Text <> "" Then
lanote = 30 + Frmprincipale.txtNote(Index).Text + 24
Note = RGB(144, lanote, 127)
midiOutShortMsg hMidiOut, Note
End If
Index = Index + 1
Next

ensuite, il faut changer la procédure Sleep par autre chose, une boucle avec des DoEvents pour éviter le blocage

Daniel

un truc du genre:

Private Declare Function GetTickCount Lib "kernel32" () As Long Dim tp As Long tp = GetTickCount + Temps While GetTickCount < tp DoEvents Wend

Daniel

merci!

mailto:S0KARISS@hotmail.com