Delphi - 闲来无事,自己写个Timer玩玩(多线程Timer)
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了Delphi - 闲来无事,自己写个Timer玩玩(多线程Timer)相关的知识,希望对你有一定的参考价值。
明天去坐火车,回家,今天就没有事做,本来在弄一个跨进程获取其他程序里面组件,如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
以上是关于Delphi - 闲来无事,自己写个Timer玩玩(多线程Timer)的主要内容,如果未能解决你的问题,请参考以下文章