La boucle prend la main et empêche l'affichage

**pubthi** · 12/08/2020, 16h37

bonjour à tous
j'ai un soucis avec les boucles et Lazarus que j'utilise depuis peu.

Je m'explique: j'ai un bouton, un memo et une boucle qui compte de 1 à 10000 avec affichage dans le mémo (et des labels).
Je veux afficher avec les labels, au cours de comptage, différents étapes; quand le compte est à 1000, 4000 et 8000 par exemple.
Le problème est que ces différents affichages (labels) ne se font qu'une fois la boucle terminée et non pas au fur et à masure du comptage. (l'affichage dans le mémo se fait normalement)
Comment faire pour remedier à ce problème?
(je n'avais pas çà sous Delphi)

Merci à tous pour vos interventions et vos solutions

Mon extrait de code...

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
procedure TForm1.Button1Click(Sender: TObject);
var   i:integer;
       s:string;
begin
  i:=0;
  while  i<10000 do
  begin
     i:=i+1;
     if i>1000 then Label1.caption:='Etape 1 (1000)';
     if i>4000 then Label2.caption:='Etape 2 (4000)';
     if i>8000 then Label3.caption:='Etape 3 (8000)';
     str(i,s);
     Memo1.Lines.Add(s);
   end;
end;

**BeanzMaster** · 12/08/2020, 17h29

Bonjour bienvenu,

Utilises Application.ProcessMessages;

Code :

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

1
2
3
4
5
 if i>1000 then 
 begin
   Label1.caption:='Etape 1 (1000)';
   Application.ProcessMessages;
 end;

Ou sinon places le à la fin de ta boucle

PS : Utilises la balise code # pour les bout de code. Merci d'avance

A+

**pubthi** · 12/08/2020, 17h56

Merci pour la réponse rapide
Malheureusement çà ne change rien...
(j'ai mis les balises)

**BeanzMaster** · 12/08/2020, 19h04

Envoyé par pubthi

Merci pour la réponse rapide
Malheureusement çà ne change rien...
(j'ai mis les balises)

Je sais pas ce que tu as fait mais ça devrait fonctionner :

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
procedure TForm1.Button1Click(Sender: TObject);
var   i:integer;
       s:string;
begin
  i:=0;
  while  i<10000 do
  begin
     i:=i+1;
     if i>1000 then
     begin
       Label1.caption:='Etape 1 (1000)';
       application.ProcessMessages;
     end;
     if i>4000 then
     begin
       Label2.caption:='Etape 2 (4000)';
       application.ProcessMessages;
     end;
     if i>8000 then
     begin
       Label3.caption:='Etape 3 (8000)';
       application.ProcessMessages;
     end;
     str(i,s);
     Memo1.Lines.Add(s);     
   end;
end;

ou

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
procedure TForm1.Button1Click(Sender: TObject);
var   i:integer;
       s:string;
begin
  i:=0;
  while  i<10000 do
  begin
     i:=i+1;
     if i>1000 then Label1.caption:='Etape 1 (1000)';
     if i>4000 then Label2.caption:='Etape 2 (4000)';
     if i>8000 then Label3.caption:='Etape 3 (8000)';
     str(i,s);
     Memo1.Lines.Add(s);
     application.ProcessMessages;
   end;
end;

A+

**pubthi** · 12/08/2020, 19h16

Envoyé par BeanzMaster

Je sais pas ce que tu as fait mais ça devrait fonctionner :

A+

J'ai bien fait comme tu l'as proposé (les 2 solutions). Mais pas de changement...

**BeanzMaster** · 12/08/2020, 23h48

Envoyé par pubthi

J'ai bien fait comme tu l'as proposé (les 2 solutions). Mais pas de changement...

Ton problème vient d'ailleurs quelle version de Lazarus utilises tu ? sous quel OS ? as tu d'autres parties de code dans ton application ?

**pubthi** · 13/08/2020, 10h40

Envoyé par BeanzMaster

Ton problème vient d'ailleurs quelle version de Lazarus utilises tu ? sous quel OS ? as tu d'autres parties de code dans ton application ?

Bonjour
J'y ai pensé aussi. J'avais la version 2.0.2, j'ai maintenant la 2.0.10 avec win7. Sur d'autres Pc, même problème.
Le code donné dans mon premier message n'est qu'un exemple. J'ai d'autres projets en cours avec ce problème. Tant que la boucle tourne, l'appli est "coincée", impossible de faire quoique ce soit, cliquer un bouton par exemple.

**Jipété** · 13/08/2020, 10h48

Envoyé par BeanzMaster

Je sais pas ce que tu as fait mais ça devrait fonctionner :

Tutafait !
Ça fonctionne tout à fait bien, même sous Linux, même avec mon vieux 1.4 (le 2.0.10 n'est pas encore en prod'), et on peut même améliorer un poil :

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
procedure TForm1.Button1Click(Sender: TObject);
var   i:integer;
       s:string;
begin
  i:=0;
  while  i<10000 do
  begin
     i:=i+1;
     if i>1000 then Label1.caption:='Etape 1 (1000)';
     if i>4000 then Label2.caption:='Etape 2 (4000)';
     if i>8000 then Label3.caption:='Etape 3 (8000)';
     str(i,s);
     Memo1.Lines.Add(s);
     if i mod 20 = 0 then Application.ProcessMessages; // speed up !
   end;
end;

Ça permet de ne mettre à jour l'affichage qu'une fois tous les 20 tours de boucle : ça speede grave et ça laisse quand même respirer la machine,

Envoyé par pubthi

J'ai d'autres projets en cours avec ce problème. Tant que la boucle tourne, l'appli est "coincée", impossible de faire quoique ce soit, cliquer un bouton par exemple.

C'est un grand classique. Il y a autre chose ailleurs qui coince…
PS : on est tous passé par là, alors pas de panique,

**jurassic pork** · 13/08/2020, 11h43

hello,
Le souci dans cette procédure c'est qu'on a une boucle infernale. On ne laisse pas "respirer" le CPU. ça boucle, ça boucle. D'ailleurs il faudrait regarder le gestionnaire de tâches pour voir l'occupation CPU du programme pendant l'exécution de cette procédure. On pourrait à la place utiliser un timer pour effectuer le comptage tous les x temps et tester quand on arrive à certaine valeurs.
Ami calmant, J.P (sans T)

**pubthi** · 13/08/2020, 12h02

Envoyé par BeanzMaster

Bonjour bienvenu,

Utilises Application.ProcessMessages;

""Les voies du "Lazarus" sont impénétrables""

J'ai réinstallé Lazarus et.... çà fonctionne (avec 'Application.ProcessMessages' dans la boucle...)
Allez savoir pourquoi...

Merci à tous et surtout à BeanzMaster

**tourlourou** · 13/08/2020, 12h46

Peut-être manquait-il une déclaration en uses rendant inopérant cet appel sous Windows ?

**Jipété** · 13/08/2020, 13h38

Coucou Y.,

Envoyé par tourlourou

Peut-être manquait-il une déclaration en uses rendant inopérant cet appel sous Windows ?

Hum hum, ça n'aurait pas passé la compil (ou alors ça se déglingue grave !)

**tourlourou** · 13/08/2020, 14h30

Salut JP,
C'est une bribe de souvenir de cas où une procédure multi-plateformes était ignorée sur certaines, simple DoNone là pour compatibilité.
Au pire, je n'aurais proféré qu'une bêtise de plus

**FOCUS77** · 13/08/2020, 20h04

Bonjour à tous

J'espère que tout le monde va bien dans ces moments difficiles !

Donc permettez-moi de vous proposer mon code amélioré, je l'ai essaye il a fonctionné convenablement

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
procedure TForm1.Button1Click(Sender: TObject);
  var   i:integer;
       s:string;
begin
  i:=0;
  while  i<10000 do
  begin
     i:=i+1;
     if  i=1001 then begin Label1.caption:='Etape 1 (1000)'; Application.ProcessMessages ;end;
     if  i=4001 then begin Label2.caption:='Etape 2 (4000)'; Application.ProcessMessages ;end;
     if  i=8001 then begin Label3.caption:='Etape 3 (8000)'; Application.ProcessMessages ;end;
     str(i,s);
     Memo1.Lines.Add(s);
   end;
end;

**Jipété** · 14/08/2020, 08h16

Salut salut,

Envoyé par tourlourou

souvenir de cas où une procédure multi-plateformes était ignorée sur certaines, simple DoNone là pour compatibilité.

Un petit exemple pour qu'on comprenne bien ?

---

Envoyé par FOCUS77

Donc permettez-moi de vous proposer mon code amélioré, je l'ai essaye il a fonctionné convenablement

amélioré ?
Amuse-toi à rajouter un autre bouton avec une seule ligne de code genre label4.Caption := 'test'; tout en passant la boucle à while i<500000 do et tu verras que tu es bloqué, surtout si tu cliques après Label3.caption:='Etape 3 (8000)'; : ta boucle ne "respire" plus…

**tourlourou** · 14/08/2020, 20h43

Bonsoir Jean-Pierre,

Malheureusement, si ma mémoire était meilleure et mon souvenir plus précis qu'une impression, j'aurais pu être plus affirmatif, mais ce n'est qu'un sentiment que je ne relie pas à un exemple précis jusqu'ici...

Si je retrouve l'exemple, je ne manquerai pas de vous faire profiter de ma joie de l'avoir retrouvé !

**Gouyon** · 17/08/2020, 10h07

Bonjour
As tu pensé à utiliser les threads?
Tel que tu as écrit ton code la boucle de comptage s’exécute dans le thread principal et bloque toute ton application.
Une solution consiste à utiliser les threads en créant un thread dans lequel ta boucle va s'éxécuter et chaque fois que le compteur atteint une valeur définie tu apelle une fonction du thread principal qui rafraichi l'affichage.
En résumé

Code :

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

1
2
3
4
5
6
7
 
procedure TForm1.Button1Click(Sender: TObject);
 
begin
//Création du thread et lanclement du thread
//voir les différent article sur les threads sous lazarus
end;

Code :

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

1
2
3
4
5
6
 
procedure TForm1.MajAffichage (S: String);      
begin
 Memo1.Lines.Add(s);
 update;
end;

Dans le run du thread

Code :

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

1
2
3
4
5
6
7
8
9
10
 
 
  i:=0;
  while  i<10000 do
  begin
     i:=i+1;
     if  i=1001 then MajAffichage('Etape 1 (1000)');
     if  i=4001 then MajAffichage(''Etape 2 (4000)'
     if  i=8001 then MajAffichage(''Etape 3 (8000)';    
   end;

La boucle prend la main et empêche l'affichage [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager