Discussion :

[DURVILLE]

En utilisant ce code trouvé sur le net (et modifié légèrement pour mon besoin perso) je me suis aperçu (sous Vista Familial) que parfois, de façon aléatoire, le compteur "passe tout droit" et au lieu de se remettre à zéro poursuit son décompte de minutes (TpsEcoul dans le Label1).

Pour être clair : 2 compteurs affichés:
- un qui se remet à zéro quand il a compté 60 secondes (label1)
- un qui totalise les minutes (affiché dans label2)

Quelqu'un a-t-il une idée de ce bug ?
Je suis prêt à utiliser une autre méthode si besoin.

MERCI BCP d'avance...

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
{Logiciel qui affiche un compte secondes et un totalisateur de minutes}
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
var
   Form1: TForm1;
   TheTime:Integer;
   TimeText :String;
   tpsecoul:String ;  // le temps écoulé en secondes
   nb_minutes: Integer;        // totalise les minutes
 
implementation
 
{$R *.DFM}
       // timer : interval réglé à 1000
Function GetCounter(Second:Integer):String;
Var
 Minute,NewSecond,Hour : Currency;
 
 Begin
  Hour       := Int(Second / 3600);
  Minute     := Int((Second-(Hour*3600))/60);
  NewSecond  := Second-int(Hour*3600+Minute*60);
  GetCounter := CurrToStr(Minute)+':'+CurrToStr(NewSecond);
End;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 TheTime:=GetTickCount;
  nb_minutes:=1; //  c'est la minute N°1 au départ
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 
 TpsEcoul:=GetCounter(GetTickCount Div 1000 -TheTime  Div 1000);
 If tpsEcoul='1:0' then   // mise à zéro du compteur à 1 minute
    Begin
    TheTime:=GetTickCount;
    Beep;
    inc(nb_minutes);  // incrémente les minutes
    End;
 
 Label1.Caption:=TpsEcoul;
 Label2.Caption:=IntToStr(nb_minutes); // affiche compteur minutes
end;
 
end.

[qi130]

C'est bien sûr cette comparaison qui est en cause:

Code :

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

If tpsEcoul='1:0'

Au moment où le timer est activé, le temps de parcours de ton code fait que la condition n'est pas vérifiée. Il faudra trouver un autre moyen, d'autant que tester une chaine me parait peu orthodoxe quand on peut valablement tester du numérique.

Il me semble que la FAQ montre un exemple de décompte du temps très précis...

[DURVILLE]

la FAQ donne cette piste :
en utilisant la fonction IsValideTime().

Je vais essayer ...

[DURVILLE]

En fouinant j'ai écrit ça ...
Peut-être pas très orthodoxe ...

ça marche et j'appliquerai à ce que je veux faire (prog plus haut)
Mais les commentaires ou corrections ou variantes seront bienvenues...

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
// chrono basique pour 10 secondes --- Avr 2008
unit Unit1;
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure Delay(dwMilliseconds: Longint);
var
  iStart, iStop: DWORD;
begin
  iStart := GetTickCount;
  repeat
    iStop := GetTickCount;
    Form1.label1.caption :=IntTostr(istop div 1000-iStart div 1000);
    Application.ProcessMessages;
    Sleep(1); 
  until (iStop - iStart) >= dwMilliseconds;
 
 
  MessageDlg('Temps écoulé !.',mtCustom,mbOkCancel,0)
 
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   delay(10000);
end;
 
end.

[DURVILLE]

On va considérer comme "résolu" car effectivement c'était une erreur de tester sur un label.

Par contre je vais relancer sur un sujet approchant car je n'ai pas tout compris !