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


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM