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
|
{
================================================================================
Composant TMMTimer pour Delphi
Guy Tessier (Guyt), guyt54@gmail.com
dernière revision: 2012/03/24
Compilé avec XE2, testé en Windows 7.
Fontionnera surement jusqu'à Delphi 1 en XP (et peut-être Windows 3.1)
peut-être faudra-t-il changer les noms dans "uses"
Équivalent au "TTimer", mais avec une précision de 1 ms (au lieu de 50 ms)
Utilise les fonctions multimédia.
================================================================================
}
unit MMTimer;
interface
uses // en XE2
MMSystem, Winapi.Windows,System.SysUtils, System.Classes;
{ probablement pour versions antérieures
uses
MMSystem, Windows, SysUtils,Classes;
}
type
TMMTimer = class(TComponent)
private
fTimerID : integer ;
fOpened : boolean ;
fInterval : integer ;
fEnabled : boolean ;
fOnTimer : TNotifyEvent ;
procedure Open ;
procedure Close ;
procedure SetEnabled(Enabled:boolean) ;
procedure SetInterval(Interval:integer) ;
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
constructor Create(aOwner:TComponent) ; override ;
destructor Destroy ; override ;
published
{ Déclarations publiées }
property Enabled:boolean read fEnabled write SetEnabled default false ;
property Interval:integer read fInterval write SetInterval default 1000 ;
property OnTimer:TNotifyEvent read fOnTimer write fOnTimer ;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Guyt', [TMMTimer]);
end;
// ===========================
// Constructeur et destructeur
// ===========================
constructor TMMTimer.Create(aOwner:TComponent) ;
begin
inherited Create(aOwner) ;
fInterval := 1000 ;
fEnabled := false ;
fOnTimer := nil ;
end ;
destructor TMMTimer.Destroy ;
begin
Close() ;
inherited Destroy ;
end ;
// ================
// Méthodes privées
// ================
procedure TMMTimerCallBackProc(uTimerID,uMessage,dwUser,dw1,dw2: DWORD) ; stdcall;
// stdcall delphi call badk functions
// dwUser contient l'adresse de l'instance de TNewTimer
var Timer : TMMTimer ;
begin
timer := TMMTimer(dwUser) ;
if Assigned(timer.fOnTimer) then
timer.fOnTimer(timer) ;
end ;
procedure TMMTimer.Open ;
begin
Close() ;
fTimerID := timeSetEvent(fInterval,0,@TMMTimerCallBackProc,
DWORD(self),TIME_PERIODIC);
fOpened := (fTimerID <> 0) ;
end ;
procedure TMMTimer.Close ;
begin
if (fOpened) then
begin
fOpened := false ;
timeKillEvent(fTimerID);
end;
end;
procedure TMMTimer.SetEnabled(Enabled:boolean) ;
begin
fEnabled := Enabled ;
Close() ;
if fEnabled then Open ;
end ;
procedure TMMTimer.SetInterval(Interval:integer) ;
begin
fInterval := Interval ;
if fEnabled then
begin
Close ;
Open ;
end ;
end ;
end. |
Intérêt pour un Timer précision 1 ms et un ComPort?
Répondre avec citation
Envoyé par Teddy
Partager