Discussion :

[Arkham46]

Bonjour à tous,

Vous pouvez sur cette discussion commenter l'article suivant :
Créez un formulaire d'attente pour les longs traitements

Aperçu :


Commentaires, critiques, remerciement, ... Tout est bienvenu si c'est constructif.

Pensez également à ajouter une note. ("Noter la discussion" en haut à droite)
Votre avis nous intéresse.

[Domi2]

Bonjour,

Tout simplement excellent !

J'ai particulièrement apprécié le fait que ce tutoriel s'adresse à un large public.

Une première partie qui permet de mettre rapidement en oeuvre une barre de progression avec un minimum de connaissances, puis une très belle démonstration pratique de l'utilisation d'un module de classe pour faciliter l'utilisation du formulaire et enfin ajouter l'animation.

On en redemande !

Domi2

[nico84]

Pour l'instant je me contente de la barre d'avancement standard syscmd mais peut-être qu'un jour...

[Jean-Philippe André]

je viens de m'y soumettre à mon tour, pour combler un peu les périodes d'attente de mes utilisateurs.
Un vrai plaisir à lire, super simple à comprendre et à appliquer, et que dire de la satisfaction des utilisateurs

[Jeannot45]

Bravo
J'ai beaucoup apprécié :

• La description des propriétés utilisées
• La simplicité des explications
• Les illustrations documentées

On ne peut que le conseiller à tout développeur

[User]

Même commentaire : Simple et excellent.

Je me posais juste une question:

Je me mets à la place d'un utilisateur lambda...
et j'espère ne pas compliquer les choses car j'ai bien vu dans ton article que tu précises pour le test que tu te fixe un intervalle de mise à jour (500 itérations).

Pour un utilisateur quelconque qui souhaite utiliser ce formulaire, l'idée c'est donc d'adapter les choses en fonction du nombre d'itérations (lNbIterations) ici égales à 10000.

Dans ce cas si on souhaite des pas (incréments) de 5% (1/20) de la barre de progression, 1 incrément représentera donc 500 itérations sur un total de 10000 itérations (500/10000=1/20).

Donc, on "incrémente" la barre si (lCptIteration1 modulo 500 = 0)

Si maintenant on a 20000 itérations (lNbIterations=20000) alors on fera modulo 1000 (1000/20000=1/20) si on souhaite gardé des pas de 5%.

C'est un peu l'idée non

PS: on peut peut-être faire la même chose sur le parcours d'un recordset avec la propriété recordset.PercentPosition.

[Arkham46]

Si maintenant on a 20000 itérations (lNbIterations=20000) alors on fera modulo 1000 (1000/20000=1/20) si on souhaite gardé des pas de 5%.

C'est un peu l'idée non

Oui c'est un peu l'idée.

Il faut trouver le bon pas d'affichage pour :
- ne pas raffraichir inutilement l'écran toutes les 2 millisecondes pour ne pas ralentir le traitement
- raffraichir quand même assez fréquemment pour ne pas avoir d'impression d'application plantée

Sur des traitements courts, on peut envisager de masquer la barre de progression et se contenter d'un formulaire fixe.

PS: on peut peut-être faire la même chose sur le parcours d'un recordset avec la propriété recordset.PercentPosition.

Oui oui PrecentPosition peut être utile pour un recordset.
Je parlerai des recordsets dans le deuxième épisode de l'article.

[ilank]

Bonjour à tous,

je profite de cette discussion pour vous soumettre un code qui semble permettre de simuluer du multitâche.
Bref, ça semble marcher en testant
Sous Access 2000, Windows XP SP3 (Pentium4 2.6 Ghz 51 cache) 640 Mo de ram.

Les fonctions à éxécuter doivent obéir au même protocole (prototypage et séquence de traitement)
Pour exemple; la boucle d'Arkham devient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Function Arkham (Code As Integer, ByRef lParam as variant) As Variant
 Dim lCptIteration2 As Long, lString As String
 Select Case Code
  Case acLBInitialize
   Arkham = True 
  Case acLBOpen
   lParam = 1
   Arkham = True
  Case acLBGetPrompt
   Arkham = "Veuillez patienter durant le traitement"
  Case acLBGetRowCount
   Arkham = 10000
  Case acLBGetValue
   For lCptIteration2 = 1 To 1000
     lString=Chr(lParam + lCptIteration2) mod 256)
   Next lCptIteration2
   lParam = lParam + 1
   Arkham = lParam
  Case acLBEnd
   Arkham = (lParam >= 10000)
 End Select
End function

j'ai oublié de préciser, pour lancer plusieurs traitements cliquer plusieurs fois sur le bouton MultiThread du formulaire FormTest, le code lancera le nombre de traitements indiqué dans la textbox.
Puisqu'il s'agît d'une ébauche de travail ne lancer pas plus de 5 traitements.

[ilank]

Bonsoir,

Voilà un aperçu de ce que j'obtiens en cliquant 4 fois le bouton MultiThread.
1 seul traitement est lancé à chaque click.

[ilank]

Bonjour à tous,

à dire vrai j'aurais besoin de vos commentaires pour faire évoluer l'idée.

[Arkham46]

Bonjour à tous,

à dire vrai j'aurais besoin de vos commentaires pour faire évoluer l'idée.

Il faut déjà un peu de temps pour analyser ton code

Sinon j'utilise de temps en temps des timers pour simuler le multi-tâche.
C'est efficace dans certains cas, il faut juste faire attention à ce qu'on fait.

J'ai essayé de décortiqué vite fait ton programme.
Le résultat est intéressant mais c'est pas super facile à comprendre comment les modules et les formulaires sont utilisés.

[ilank]

Bonsoir Arkham,

effectivement j'utilise des objets que je n'ai pas vraiment paufiner, et je me suis consciencieusement appliqué à ne placer aucun commentaire dans le code.

Bon le post va être long
Classe ClRegistre, sert à stocker des objets ou des variables. Element de base des classes ClPile, ClListeChainee .....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'Classe clRegistre
Public RegistreEntry 'Valeur, Variable Objet Stocké
Public NextRegistre As clRegistre 'Pointeur vers le ClRegistre suivant
Public PreviousRegistre As clRegistre 'Pointeur vers le ClRegistre Précédent

Classe ClBoucle est en fait une liste chainée de ClRegistre où le dernier élément et le premier sont liés entre eux.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Public ptrRegistre As clRegistre 'Pointeur du ClRegistre courant
Private ptrFirst As clRegistre 'Pointeur sur le premier Registre de la liste
Private ptrLast As clRegistre 'Pointeur sur le dernier
Public Count As Long 'Nombre de Registre dans la liste
 
 
'Ajoute une valeur ou un objet en fin de liste
Public Sub Add(NewValue)
    Dim NewEntry As clRegistre
    Set NewEntry = New clRegistre
    If IsObject(NewValue) Then
        Set NewEntry.RegistreEntry = NewValue
    Else
        NewEntry.RegistreEntry = NewValue
    End If
    If (ptrLast Is Nothing) And (ptrFirst Is Nothing) Then
        Set ptrFirst = NewEntry
        Set ptrLast = NewEntry
        Set ptrRegistre = ptrFirst
    End If
    Set ptrLast.NextRegistre = NewEntry
    Set ptrFirst.PreviousRegistre = NewEntry
    Set NewEntry.NextRegistre = ptrFirst
    Set NewEntry.PreviousRegistre = ptrLast
    Set ptrLast = NewEntry
    Count = Count + 1
End Sub
 
'Suprime le Registre courant de la liste
Public Sub Remove()
    Dim Old As clRegistre
    If Count <= 0 Then Count = 0: Exit Sub
    If Count > 1 Then
        Set Old = ptrRegistre.NextRegistre
        Set ptrRegistre.PreviousRegistre.NextRegistre = ptrRegistre.NextRegistre
        Set ptrRegistre.NextRegistre.PreviousRegistre = ptrRegistre.PreviousRegistre
        Set ptrRegistre = Nothing
        Set ptrRegistre = Old
    Else
        Class_Initialize
    End If
    Count = Count - 1
End Sub
 
'Se place sur le Registre suivant dans la liste
Public Sub MoveNext()
    Set ptrRegistre = ptrRegistre.NextRegistre
End Sub
 
'Se déplace sur le Registre précédent
Public Sub MovePrevious()
    Set ptrRegistre = ptrRegistre.PreviousRegistre
End Sub
'Renvoie la valeur ou l'objet stocké dans le Registre courant
Public Function item()
    If IsObject(ptrRegistre.RegistreEntry) Then
        Set item = ptrRegistre.RegistreEntry
    Else
        item = ptrRegistre.RegistreEntry
    End If
End Function
 
Private Sub Class_Initialize()
    Set ptrFirst = Nothing
    Set ptrLast = Nothing
    Set ptrRegistre = Nothing
End Sub

une classe ClThread pour stocker les éléments de la pseudo tâche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Private Threadid As Long 'Id du Thread Non-utilisé
Private WithEvents ThreadForm As Form 'Formulaire fournissant le timer
Private ProgressBar As clProgress 'Objet Barre de progression
Private ThreadProc As String 'Nom de la fonction à appeler
Private ThreadParam As Variant 'Adresse des paramètres propre à la fonction
Private Iteration As Long 'Nombre d'itération effectués
Private Loops As Long 'Nombre total d'itérations à effectuer
Private Token As Boolean 'Jeton autorisant l'éxécution de la tâche
Public Event Started() 'Evénement Démarré - Non utilisé
Public Event Canceled()'Evénement Annulé - Non utilisé
Public Event Asleep() 'Evénement Endormi
Public Event Complete() 'Evénement Terminé 
 
Private Sub Class_Initialize()
    Set ThreadForm = New Form_FormThread
    ThreadForm.OnTimer = "[Event procedure]"
End Sub
 
'Le Timer sert à mettre fin à l'éxécution de la procédure RunThread
'Redonne la main au programme appelant, le gestionnaire de la boucle
'On peut aussi lever un événement permettant à l'objet parent
'de passer la main au Thread suivant dans la boucle
Private Sub ThreadForm_Timer()
    Token = False
    ThreadForm.TimerInterval = 0
    RaiseEvent Asleep 
End Sub
 
'Initialisation de la tâche
'Si la fonction contenue dans ThreadProc renvoie False le Thread ne sera pas ajouté à la boucle de traitement
Public Function Init(ProcedureName As String, lParam As Variant) As Boolean
    Init = False
    If ProcedureName = "" Then Exit Function
    ThreadProc = ProcedureName
    ThreadParam = lParam
'Initialisation de la tâche permier appel à la fonction
    If Run(ThreadProc, acLBInitialize, ThreadParam) = 0 Then Exit Function
'Ouverture de la tâche
    If Run(ThreadProc, acLBOpen, ThreadParam) = 0 Then Exit Function
'Récupération du nombre total d'itérations 
    Loops = Run(ThreadProc, acLBGetRowCount, ThreadParam)
    If Loops <= 0 Then Exit Function
'Chargement de l'objet ClProgress
    Set ProgressBar = New clProgress
    ProgressBar.Modal = False
    ProgressBar.AnimationTimer = 250
    ProgressBar.GeneralInfo = "Veuillez patienter durant le traitement..."
    ProgressBar.ProgressMin = 1
    Iteration = 1
    ProgressBar.ProgressMax = Loops
    ProgressBar.ProgressPercent = 0
    ProgressBar.Visible = True
    Init = True
End Function
 
'Boucle de Traitement de la tâche
Public Sub RunThread(Duration As Long)
    Dim OldPercent As Single
    Token = True
    ThreadForm.TimerInterval = Duration
    While Token = True And Iteration < Loops
'Exécute la tâche et attend en retour le nombre d'itération exécuté
        Iteration = Run(ThreadProc, acLBGetValue, ThreadParam)
'Mise à jour de la barre de progression
        ProgressBar.ProgressPercent = Iteration / ProgressBar.ProgressMax
'Temporisation via un test pour limiter la fréquence des DoEvents
'En retirant le test on récupére en occupation CPU,
'la tâche mettra nettement plus de temps pour se terminer
        If ProgressBar.ProgressPercent > OldPercent + 0.01 Then
            ProgressBar.ProgressInfo = Run(ThreadProc, acLBGetPrompt, ThreadParam) & FormatPercent(ProgressBar.ProgressPercent, 0)
            OldPercent = ProgressBar.ProgressPercent
            ProgressBar.Repaint
            DoEvents
        End If
    Wend
'Vérifie que la tâche est bien fini
'si retour ThreadProc = True alors lever l'événement Complete
    If Run(ThreadProc, acLBEnd, ThreadParam) = True Then
        Set ProgressBar = Nothing
        RaiseEvent Complete
    End If
End Sub

Le gestionnaire de la boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Dim ThreadChain as ClBoucle
Dim NewThread As ClThread 'Permet d'ajouter un objet à la boucle
Private WithEvents CurrentThread As ClThread 'Thread en cours d'éxécution
 
'Le Thread courant s'est mis en veille
'Placer le pointeur de la boucle sur le prochain thread
Private Sub CurrentThread_Asleep()
 ThreadChain.MoveNext
End sub
 
'Le Thread courant est terminé
Private Sub CurrentThread_Complete()
 ThreadChain.Remove
 Set CurrentThread = Nothing
End if
 
'Exécution des threads par unité de temps
Private Sub Form_Timer()
    If Not (ThreadChain Is Nothing) Then
'Si la boucle contient au moins un item
          If ThreadChain.Count > 0 Then
            Set CurrentThread = ThreadChain.item
'Exécution pendant 25 milisecondes
            CurrentThread.RunThread 25
'Si la boucle est vide la supprimer 
        Else
            Set ThreadChain = Nothing
            TimerInterval = 0
            OnTimer = ""
        End If
    End If
    DoEvents
End Sub

Concernant les fonctions appelées je m'appuie ici sur des constantes Access, utilisées lorsqu'une fonction est source de données d'une ListBox, ComboBox.
acLBInitialize, acLBOpen... excepté le acLBGetPrompt
La fonction reçoit un paramètre de type variant qu'elle seule sait interpréter notamment pour stocker les infos qu'ils lui sont nécessaires pour effectuer le traitement, par exemple une copie de fichier via des FreeFile... il faut pouvoir conserver les handles des fichiers source et destination; si on veut utiliser la même fonction pour éxécuter deux copies différentes il faut que chaque tâche dispose d'un contexte d'éxécution, le lParam est conservé dans la propriété ThreadParam de l'objet ClThread.
Pour finir, ici j'ai ajouté le formulaire de progression mais on pourrait aussi se contenter de notifier le démarrage et la fin d'éxécution de la tâche via un Popup; et donc envisager de simuler des tâches de fond.

Je sais que certains pourront améliorer l'ensemble, donc...

[vodiem]

salut à tous ,

j'ai survolé rapidement le sujet, je n'aurais donc pas grand chose à dire sur le fond.
c'est pas grand chose mais il y a juste un truc qui me chiffonne: il n'y a pas d'annulation du traitement.
je n'ose pas imaginer si le traitement avait un réel pb ou si cela doit durer une heure...

autrement à l'air écolo et avec le réchauffement climatique j'aurais pas mis une usine fumante
je sais: c'est pas constructif, mais fallait que je le dise...


bravo.

[ilank]

Bonjour,

vodiem, mais de quoi parles-tu ?

[vodiem]

salut ilank,

he bien je trouve qu'il manque un petit bouton annuler sur le formulaire.
c'est pas grand chose et si la plupart saurait mettre cela en place, ca ne mange pas de pain de rajouter une ligne pour cela.

ps: Intéressant aussi l'idée du multiThread mais je trouve que cela complique le sujet : cela mérite un sujet à part.

[ilank]

Bonjour,

l'idée première d'Arkham est de présenter un tuto de création de formulaire signalant la progression d'une tâche en cours. Excepté le nombre de boucles, le formulaire d'attente est totalement indépendant de la tâche.
Une annulation est quant à elle totalement dépendante à la fois de la tâche et de l'objet dans laquelle elle a été lancé. Il faudrait pour ce faire, créer une classe d'objet par tâche avec progression; car en cliquant sur un bouton Annuler à qui signales-tu la demande d'annulation au formulaire d'attente ou à la boucle de traitement ?

[vodiem]

je peux concevoir que le formulaire d'attente ne soit qu'informatif.
mais à tout traitement long, je pense qu'il faudrait avoir la possibilité d'annuler celui-ci.
après que ce soit un bouton sur le formulaire d'attente ou ailleurs peu importe, bien que je pense que dans la majorité des cas annuler le traitement à partir du formulaire d'attente soit pertinent.

mais je suis d'accord ce n'est pas l'objectif premier du tuto.

[Arkham46]

je pense au bouton d'annulation
ce sera pour la deuxième partie de l'article

[miabi]

Très clair et très bien fait.
Exactement ce dont j'avais besoin merci

[curt]

Bonsoir Arkham46,

que dire ??? Que c'est bien... mais non ... C'EST MIEUX !!!!

Je cherchais un truc de ce type pour remplacer mes "Veuillez patienter..." tout figés et tristes.

Si tu as d'autres idées, n'hésites surtout pas... et puis....

JOYEUX NOEL