Discussion :

[sgmsg]

Bonjour à tous

C'est une question simple, enfin probablement.

Je dérive un composant timer. Et j'aimerais que ce soit le composant lui-même qui intervienne sur l’événement OnTimer.

Alors comment doit-on écrire la déclaration?

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
type oAlarme=class(TTimer)
private
    procedure POntimer(Sender: TObject);//C'est ce qui devrait être réécrit
public
    constructor create;
    destructor destroy;
published
    property OnTimer: TNotifyEvent write POnTimer;//ou ici
end;
var
implementation
    procedure POnTimer(Sender);
    begin
    ....//ou ici
    end;

[tourlourou]

Bonjour,
Si ton objet gère exclusivement par lui-même le Timer interne dont il dérive et n'a pas à exposer l'événement OnTimer, peut-être suffit-il d'un objet qui ne dérive pas d'un Timer mais en utilise un ?

[Andnotor]

Il suffit de surcharger la méthode Timer :

Code :

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

1
2
3
4
type oAlarme=class(TTimer)
protected
    procedure Timer; override;
end;

[sgmsg]

Il suffit de surcharger la méthode Timer :

Code :

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

1
2
3
4
type oAlarme=class(TTimer)
protected
    procedure Timer; override;
end;

C'est exactement ça.

Merci

[sgmsg]

Bonjour,
Si ton objet gère exclusivement par lui-même le Timer interne dont il dérive et n'a pas à exposer l'événement OnTimer, peut-être suffit-il d'un objet qui ne dérive pas d'un Timer mais en utilise un ?

Tu es un génie.

C'est ce que j'aurais dû faire.

Comment on intercepte l'évènement ontimer dans ce nouveau composant alors ?

[ALWEBER]

Bonjour,

Je prends la discussion en cours. Dans ce que tu décris je vois un objet qui dérive de Ttimer mais qui n'a pas de fonction supplémentaires ;
A titre d'exemple je travaille actuellement sur l'association d'un socket et d'un timer et je le décrit comme suit :

Code :

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

1
2
3
4
5
6
7
8
9
10
 
  TS16Client = class
    CSocket1: TClientSocket;
    Timer1: TTimer;
    constructor create;
    destructor Destroy; override;
    procedure Initialise(AOwner: TComponent; stIP, StPort: String);
    procedure Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
  end;

[ALWEBER]

...
Comment on intercepte l'évènement ontimer dans ce nouveau composant alors ?

Code :

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

1
2
3
4
 
  Timer1 := TTimer.create(AOwner);
  Timer1.Interval := 500;
  Timer1.OnTimer := Timer1Timer;

Dans le morceau de code que je t'ai envoyé tu peut dériver ta classe plutôt de TComponent ce qui permet le passage du paramètre AOwner

[sgmsg]

Excellent, ça fonctionne!

Merci pour tout.

[sgmsg]

Ça pourra intéresser quelques uns:

Voici le code pour gérer plusieurs routines avec un seul timer.

Le but est de limiter les ressources autrement allouées dans une multitude de timer.

Il y a toutefois une certaine dérive dû au délais engendrer par l'exécution des processus appelés (composants visuels). Voir la note dans le code pour "endiguer" le problème.

L'avantage c'est qu'il permet en mode déverminage, d'empêcher l'accumulation d'appel de timer sur la pile engendrant des résultats aberrant ou des erreurs;

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
unit Alarme;
 
(****************************************)
(************* SGMSG  *******************)
(***********  2016/11/15  ***************)
(****************************************)
(****************************************)
 
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, math;
type tProcedure=procedure of object;
type oProcedure=class
Private
    vIntervalle:Longword;
    vActive:boolean;
    vHeure:tdatetime;
Public
    LaProcedure:tProcedure;
    constructor create(UneProcedure:tProcedure;Intervalle:Longword=0;Active:Boolean=True);//;Heure:tdatetime=0);
    procedure Lance;
    Property Intervalle:Longword read vIntervalle write vIntervalle;
    Property Active:Boolean read vActive write vActive;
    Property Heure:tdatetime read vHeure write vHeure;
end;
 
 
type oAlarme=class
private
    CompteurDeProcedure:integer;
    Alarme:tTimer;
    Cedule:tstringlist;    //contient ladate-heure-miliseconde associé à l'objet contenant les infos pour lancer la procedure
    Pointeurs:tstringlist;
    procedure pOnTimer(Sender: TObject);
    procedure FixeAlarmeSysteme;
protected
 
public
    constructor create(Aowner:tcomponent);
    destructor destroy;override;
    function Arrete(LaProcedure:tProcedure):boolean;
    function Active(LaProcedure:tProcedure;Intervalle:integer;Heure:tdatetime=0):boolean; //Cedule un lancement du programme associé à Etiquette
    function LisIntervalle(LaProcedure:tProcedure):integer;
    procedure ModifieIntervalle(LaProcedure:tProcedure;Intervalle:integer);
 
 
end;
 
implementation
 
{$R *.dfm}
const
    MiliSecondesParJour=60*60*24*1000;
    UnsurMili=1/MiliSecondesParJour;
 
function RemplaceCars(const Chaine:string; Caracteres:TSysCharSet=['+'..'.','0'..'9'];Par:Char=':'):string;
//ShaiLeTroll 20130505
var Len, I : integer;
begin
    Len := Length(Chaine);
    Result:=chaine;
    for I := 1 to Len do if (Chaine[i] in Caracteres) then
       Result[i] := Par;
end;
 
function ConserveCars(const Chaine : string; const Caracteres : TSysCharSet=['+'..'.','0'..'9']): string;
//ShaiLeTroll 20130505
var Len, I, J : integer;
begin
  Len := Length(Chaine);
  SetLength(Result, Len);
  J := 0;
  for I := 1 to Len do
  begin
    if (Chaine[i] in Caracteres) then begin
      inc(J);
      Result[J] := Chaine[i];
    end;
  end;
  SetLength(Result, J);
end;
 
function formateHeure(MilisecondesEnSus:Longword; var heureReference:tdatetime):string;
var r:string;
    hui,hr:double;
begin
    hui:=now;//Dérive en fonction de la durée des appels
    //hui:=heureReference;//Force l'exécution à intervale fixe, mais risque de surcharger la pile si le traitement est plus long que l'intervale alloué
    hr:=hui+(MilisecondesEnSus)*unsurMili;
    heureReference:=hr;
    r:=floattostrf(hr,ffnumber,11,5);
    r:=RemplaceCars(r,[','],'.');
    result:=ConserveCars(r);
    r:='_'+dateaAAAAMMJJ(heureReference)+'_'+heureaformat(heureReference,'HH:MM:SS:ZZZ')+'_'+heureaformat(hui,'HH:MM:SS:ZZZ');
    result:=result+r;
end;
 
constructor oProcedure.create(UneProcedure:tProcedure; Intervalle:Longword=0;Active:Boolean=True);//;Heure:tdatetime=0);
begin
    LaProcedure:=UneProcedure;
    //vEtiquette:=Etiquette;
    vIntervalle:=Intervalle;
    vActive:=Active;
end;
 
procedure oProcedure.Lance;
begin
     LaProcedure;
end;
constructor oAlarme.create(Aowner:tcomponent);
begin
    Pointeurs:=tstringlist.create;
    Pointeurs.Sorted:=true;
    Pointeurs.Duplicates:=dupAccept;
    Cedule:=tstringlist.create;
    Cedule.Sorted:=true;
    Cedule.Duplicates:=dupAccept;
    Alarme:=ttimer.create(nil);
    Alarme.OnTimer := pOnTimer;
    Alarme.Enabled:=false;
end;
destructor oAlarme.destroy;
var i:integer;
begin
    for i:=0 to Cedule.count-1 do
        Cedule.Objects[i].Free;
    Cedule.Free;
    Alarme.Free;
end;
procedure oAlarme.POntimer(Sender:Tobject);
var SousProgramme:oProcedure;
begin
    Alarme.Enabled:=false;
    SousProgramme:=Cedule.Objects[0] as oProcedure;
    SousProgramme.LaProcedure;
    Cedule.Sorted:=false;
    if SousProgramme.Active and (SousProgramme.Intervalle>0) then begin
        Cedule[0]:=formateHeure(SousProgramme.Intervalle,SousProgramme.vheure);
        FixeAlarmeSysteme;
    end else begin
        SousProgramme.Free;
        Cedule.Objects[0].Free;
        Cedule.Delete(0);
        if Cedule.count>0 then FixeAlarmeSysteme;
    end;
    Cedule.Sorted:=true;
end;
 
procedure oAlarme.FixeAlarmeSysteme;
var HeureCedulee,hui:double;
    e:integer;
    heure:string;
begin
    heure:=Cedule[0];
    e:=pos('_',Heure);
    if e>0 then
        heure:=copy(cedule[0],1,e-1);
    val(heure,HeureCedulee,e);
    hui:=now;
    Alarme.Interval:=max(1,trunc((HeureCedulee-hui)*MilisecondesParJour));
    Alarme.Enabled:=true;
end;
 
function oAlarme.Arrete(LaProcedure:tProcedure):boolean;
var iX:integer;
    iObject:Tobject;
    SousProgramme:oProcedure;
begin
    result:=false;
    for iX:=Cedule.count-1 downto 0 do begin
        SousProgramme:=Cedule.Objects[ix] as oProcedure;
        if @SousProgramme.LaProcedure=@LaProcedure then begin
            freeandnil(SousProgramme);
            Cedule.Delete(ix);
            Result:=true;
        end;
    end;
    if result and(Cedule.count>0)
        then FixeAlarmeSysteme
        else Alarme.Enabled:=false;
end;
 
function oAlarme.Active(LaProcedure:tProcedure;Intervalle:integer;Heure:tdatetime=0):boolean;
var iX:integer;
    SousProgramme:oProcedure;
    hui:tdatetime;
begin
    result:=false;
//Vérifie l'unicité de la procedure dans le systeme... pourquoi? Non, il pourra y avoir plusieurs instance en même temps c'est au programmeur de géréer ça
    hui:=now;
    if (heure<=hui)and(intervalle=0) then exit;
    SousProgramme:=oProcedure.create(LaProcedure,Intervalle,True);
    SousProgramme.vHeure:=max(hui,heure);
    if heure>hui then
        Cedule.AddObject(FormateHeure(trunc((heure-now)*MilisecondesParJour),Sousprogramme.vheure),SousProgramme)
    else
        Cedule.AddObject(FormateHeure(SousProgramme.vIntervalle,SousProgramme.vHeure),SousProgramme);
    FixeAlarmeSysteme;
    result:=true;
end;
 
function oAlarme.LisIntervalle(LaProcedure:tProcedure):integer;
var iX:integer;
    iObject:Tobject;
    SousProgramme:oProcedure;
begin
    result:=-1;
    for iX:=Cedule.count-1 downto 0 do begin
        SousProgramme:=Cedule.Objects[ix] as oProcedure;
        if @SousProgramme.LaProcedure=@LaProcedure then begin
            result:=SousProgramme.Intervalle;
            exit;
        end;
    end;
end;
 
procedure oAlarme.ModifieIntervalle(LaProcedure:tProcedure;Intervalle:integer);
begin
    if Arrete(LaProcedure) then
        Active(LaProcedure,Intervalle);
end;
end;

La fiche pour essayer :

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
83
84
85
86
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Alarme, StdCtrls, math;
 
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
 
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    Alarme:oAlarme;
    procedure Beep1;
    procedure Beep2;
    procedure Beep3;
 
  end;
 
var
  Form1: TForm1;
 
 
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    Alarme:=oAlarme.create(Sender as tComponent);
    Alarme.Active(Beep1,'2000);
    Alarme.Active(Beep2,'4000);
    Alarme.Active(Beep3,'8000);
end;
 
var vUn,vDeux,Vtrois:integer;
procedure TForm1.Beep1;
begin
    //beep;
    inc(vUn);
    memo1.lines.add(inttostr(vUn)+'_'+Alarme.Cedule[0]);
    //application.ProcessMessages;
end;
 
procedure TForm1.Beep2;
begin
    //beep;
    //application.ProcessMessages; sleep(500);application.ProcessMessages;
    //beep;
    inc(vDeux);
    memo2.lines.add(inttostr(vDeux)+'_'+Alarme.Cedule[0]);
 
end;
procedure TForm1.Beep3;
begin
    //beep;
    //application.ProcessMessages; sleep(500);application.ProcessMessages;
    //beep;
    //application.ProcessMessages; sleep(500);application.ProcessMessages;
    //beep;
    inc(vTrois);
    memo3.lines.add(inttostr(vTrois)+'_'+Alarme.Cedule[0]);
 
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
    Alarme.Arrete('Beep1');
    Alarme.Arrete('Beep2');
    Alarme.Arrete('Beep3');
end;
 
end.