明天去坐火車,回家,今天就沒有事做,本來在弄一個跨進程獲取其他程序里面組件,如ListView,ListBox,Button等的信息,突然有個想法自己寫個Timer,不用SetTimer函數,我們自己用個多線程也正好實現這個.反正前段時間多線程也弄得比較多,本來想單獨講講的,現在就用個例子來說明吧.
寫成一個控件:utTimer.pas
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
|
unit
utTimer;
interface
uses
Windows,SysUtils,Classes;
type
THuangJackyTimerThread =
class
;
THuangJackyTimer =
class
(TComponent)
private
FTimeInterval:
Integer
;
FOnTimerDo:TNotifyEvent;
FTimerThread:THuangJackyTimerThread;
FEnable:
Boolean
;
procedure
SetEnable(bBool:
Boolean
);
procedure
SetTimeInterval(aValue:
Integer
);
procedure
StopThread;
procedure
StartThread;
public
constructor
Create(AOwner: TComponent); override;
destructor
Destroy; override;
published
property
TimeInterval:
Integer
read FTimeInterval
write
SetTimeInterval;
property
OnTimerDo:TNotifyEvent read FOnTimerDo
write
FOnTimerDo;
property
Enable:
Boolean
read FEnable
write
SetEnable;
end
;
THuangJackyTimerThread =
class
(TThread)
private
FTimer:THuangJackyTimer;
FTerminateHandle,FExitHandle,FStartHandle,FStopHandle:
Cardinal
;
procedure
DoTimerEvent;
protected
procedure
Execute;override;
public
constructor
Create(AOwner: THuangJackyTimer);
destructor
Destroy; override;
end
;
procedure
Register;
implementation
procedure
Register;
begin
RegisterComponents(
'HuangJacky'
,[THuangJackyTimer]);
end
;
{ THuangJackyTimer }
constructor
THuangJackyTimer
.
Create(AOwner: TComponent);
begin
inherited
;
FTimeInterval:=
1000
;
FTimerThread:=THuangJackyTimerThread
.
Create(Self);
FTimerThread
.
Resume;
end
;
destructor
THuangJackyTimer
.
Destroy;
begin
SetEvent(FTimerThread
.
FTerminateHandle);
WaitForSingleObject(FTimerThread
.
FExitHandle,
5000
);
FTimerThread
.
Free;
inherited
;
end
;
procedure
THuangJackyTimer
.
SetEnable(bBool:
Boolean
);
begin
if
Enable = bBool
then
Exit;
if
csDesigning
in
ComponentState
then
Exit;
if
Enable
then
begin
StopThread;
FEnable:=
False
;
end
else
begin
StartThread;
FEnable:=
True
;
end
;
end
;
procedure
THuangJackyTimer
.
SetTimeInterval(aValue:
Integer
);
begin
if
FTimeInterval = aValue
then
Exit;
InterlockedExchange(FTimeInterval,aValue);
end
;
procedure
THuangJackyTimer
.
StartThread;
begin
SetEvent(FTimerThread
.
FStartHandle);
end
;
procedure
THuangJackyTimer
.
StopThread;
begin
SetEvent(FTimerThread
.
FStopHandle)
end
;
{ THuangJackyTimerThread }
constructor
THuangJackyTimerThread
.
Create(AOwner: THuangJackyTimer);
var
sTmp,sTmp1:
string
;
begin
inherited
Create(
True
);
Assert(Assigned(AOwner));
//自己創建,自己釋放,這樣能保證100%不內存泄露,個人習慣
FreeOnTerminate:=
False
;
FTimer:=AOwner;
sTmp:=FTimer
.
Name;
sTmp1:=DateTimeToStr(Now());
FTerminateHandle:=CreateEvent(
nil
,
True
,
False
,
PChar
(sTmp + sTmp1 +
'T'
));
Assert(FTerminateHandle<>
0
);
//用這個Event來通知主線程:Timer線程已經執行完了
FExitHandle:=CreateEvent(
nil
,
True
,
False
,
PChar
(sTmp + sTmp1 +
'E'
));
Assert(FExitHandle<>
0
);
FStartHandle:=CreateEvent(
nil
,
True
,
False
,
PChar
(sTmp + sTmp1 +
'Sa'
));
Assert(FStartHandle<>
0
);
FStopHandle:=CreateEvent(
nil
,
True
,
False
,
PChar
(sTmp + sTmp1 +
'So'
));
Assert(FStopHandle<>
0
);
end
;
destructor
THuangJackyTimerThread
.
Destroy;
begin
CloseHandle(FStopHandle);
CloseHandle(FStartHandle);
CloseHandle(FExitHandle);
CloseHandle(FTerminateHandle);
inherited
;
end
;
procedure
THuangJackyTimerThread
.
DoTimerEvent;
begin
if
Assigned(FTimer
.
OnTimerDo)
then
FTimer
.
OnTimerDo(FTimer);
end
;
procedure
THuangJackyTimerThread
.
Execute;
var
Waits1:
array
[
0..2
]
of
Cardinal
;
Waits2:
array
[
0..1
]
of
Cardinal
;
procedure
DoTerminate;
begin
ResetEvent(FTerminateHandle);
Terminate;
end
;
begin
Waits1[
0
]:=FStartHandle;
Waits1[
1
]:=FTerminateHandle;
Waits1[
2
]:=FStopHandle;
Waits2[
0
]:=FStopHandle;
Waits2[
1
]:=FTerminateHandle;
//循環等待.
while
not
Terminated
do
//每一次Wait后我們都需要判斷下Terminate,不然在你等待的時候,線程就被Terminate了.
//不過不判斷也不要緊
//因為Terminate只是將Terminated設置成True.
//也就是如果不判斷,就多運行一次.
//但是這個例子里面因為內層也有一個While循環,所以必須判斷
case
WaitForMultipleObjects(
3
,@Waits1,
False
,INFINITE)
of
WAIT_OBJECT_0 +
0
:
begin
ResetEvent(FStartHandle);
if
Terminated
then
Break;
while
True
do
begin
case
WaitForMultipleObjects(
2
,@Waits2,
False
,FTimer
.
TimeInterval)
of
WAIT_OBJECT_0 +
0
:
begin
ResetEvent(FStopHandle);
Break
end
;
WAIT_OBJECT_0 +
1
:
begin
DoTerminate;
Break;
end
;
end
;
if
Terminated
then
Break;
//執行Timer事件.
Synchronize(DoTimerEvent);
end
;
end
;
WAIT_OBJECT_0 +
1
:
DoTerminate;
WAIT_OBJECT_0 +
2
:
ResetEvent(FStopHandle);
end
;
SetEvent(FExitHandle);
end
;
end
.
|
兩百行的代碼,比較簡單,就是一個線程在循環等待事件,然后相應的事件做相應的事.
其實主要是想說如何使用線程,我不喜歡將線程的FreeOnTerminate設置為True,因為感覺不安全,心里不踏實呀.
測試例子:Unit1.pas
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
|
unit
Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,utTimer;
type
TForm1 =
class
(TForm)
procedure
FormCreate(Sender: TObject);
private
{ Private declarations }
Timer:THuangJackyTimer;
III:
Integer
;
procedure
DoTimer(S:TObject);
public
{ Public declarations }
end
;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure
TForm1
.
DoTimer(S: TObject);
begin
//這個Timer不存在重入的情況,所以不需要先設置Enable為True
Caption:=IntToStr(III);
Inc(III);
end
;
procedure
TForm1
.
FormCreate(Sender: TObject);
begin
Timer:=THuangJackyTimer
.
Create(Self);
Timer
.
TimeInterval:=
2000
;
Timer
.
OnTimerDo:=DoTimer;
Timer
.
Enable:=
True
;
end
;
end
.
|
D7和D2010上面都測試了一下,米有發現問題.
如果有什么問題歡迎拍磚.哈哈
http://www.cnblogs.com/huangjacky/archive/2010/02/10/1667217.html