stopper une fonction lancée sur clic

Question

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 mailto:S0KARISS@hotmail.com]

Gobillot · Answer

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

Gobillot · Answer

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

juliusius37 · Answer

merci!

[mailto:S0KARISS@hotmail.com mailto:S0KARISS@hotmail.com]

Stopper une fonction lancée sur clic

3 réponses

Discussions similaires