Author: Tomas Rutkauskas
I try to build a thread that I can send a message to order to stop. I know that
messages are normally used for screen object but the thread is also having a
handle. I 'd like to be able to send a message to this thread and having the sender
waiting until the stop is confirmed. (or something that's equivalent)
Answer:
A thread has a handle, but it is not a window handle, so you cannot send a message
to it with SendMessage. There is a PostThreadMessage API function that can be used
to send a message to the thread itself. But to receive it the thread needs a
message loop, which threads normally don't have.
If your thread is permanently slaving away in a work loop and you want to stop it
just set a boolean field declared in the thread object to true (this is what
Thread.Terminate does, for example). The work code inside the thread has to check
this field regularly to detect that it has been set, and then exit the loop.
If the thread is waiting on something and you want to wake it up you have to modify
the wait code so that it uses WaitforMultipleObjects, one of which is an event
object you can signal from outside to wake the thread up.
Here is an example for this technique:
1 {Writing an interruptible timer thread}
2
3 unit Unit1;
4
5 interface
6
7 uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9 ComCtrls, StdCtrls;
10
11 type
12 TTimerThread = class;
13 TWakeupKind = (wkTimerExpired, wkEventTriggered);
14 TWaitState = (wsIdle, wsWaiting);
15 TWakeupEvent = procedure(sender: TTimerThread; reason: TWakeupKind) of object;
16 TTimerThread = class(TThread)
17 private
18 FInterval: DWORD;
19 FReason: TWakeupKind;
20 FEvent: THandle;
21 FState: TwaitState;
22 FWakeupEvent: TWakeupEvent;
23 FNoWakeupEvent: Boolean;
24 procedure SyncWakeup;
25 protected
26 procedure DoWakeup;
27 public
28 constructor Create; reintroduce;
29 destructor Destroy; override;
30 procedure Execute; override;
31 procedure Sleep(forInterval: DWORD);
32 procedure Wakeup;
33 procedure Terminate;
34 property OnWakeup: TWakeupEvent read FWakeupEvent write FWakeupEvent;
35 property Interval: DWORD read FInterval write FInterval;
36 property State: TWaitState read FState;
37 end; {TTimerThread}
38
39 TForm1 = class(TForm)
40 StatusBar: TStatusBar;
41 WaitButton: TButton;
42 OpenDialog1: TOpenDialog;
43 Label1: TLabel;
44 WaitIntervalEdit: TEdit;
45 WakeupButton: TButton;
46 Memo1: TMemo;
47 procedure WaitIntervalEditKeyPress(Sender: TObject; var Key: Char);
48 procedure WaitButtonClick(Sender: TObject);
49 procedure FormCreate(Sender: TObject);
50 procedure FormDestroy(Sender: TObject);
51 procedure WakeupButtonClick(Sender: TObject);
52 private
53 { Private declarations }
54 FTimerthread: TTimerThread;
55 procedure TimerWakeup(sender: TTimerThread; reason: TWakeupKind);
56 public
57 { Public declarations }
58 end;
59
60 var
61 Form1: TForm1;
62
63 implementation
64
65 uses typinfo;
66
67 {$R *.DFM}
68
69 procedure TForm1.WaitIntervalEditKeyPress(Sender: TObject; var Key: Char);
70 begin
71 if not (key in ['0'..'9', #8]) then
72 Key := #0;
73 end;
74
75 procedure TForm1.WaitButtonClick(Sender: TObject);
76 begin
77 FTimerThread.Sleep(StrToInt(WaitIntervalEdit.Text));
78 memo1.lines.add('Timer started');
79 end;
80
81 procedure TForm1.FormCreate(Sender: TObject);
82 begin
83 FTimerthread := TTimerThread.Create;
84 FTimerthread.FreeOnTerminate := true;
85 FTimerthread.OnWakeup := TimerWakeup;
86 end;
87
88 procedure TForm1.TimerWakeup(sender: TTimerThread; reason: TWakeupKind);
89 begin
90 memo1.lines.add('Timer woke up, reason: ' + GetEnumName(Typeinfo(TWakeupKind),
91 Ord(reason)));
92 end;
93
94 procedure TForm1.FormDestroy(Sender: TObject);
95 begin
96 if Assigned(FTimerthread) then
97 FTimerThread.Terminate;
98 end;
99
100 procedure TForm1.WakeupButtonClick(Sender: TObject);
101 begin
102 FTimerthread.Wakeup;
103 end;
104
105 { TTimerThread }
106
107 constructor TTimerThread.Create;
108 begin
109 {create thread suspended}
110 inherited Create(true);
111 {create event object}
112 FEvent := CreateEvent(
113 nil, {use default security}
114 true, {event will be manually reset}
115 false, {event starts out not signaled}
116 nil); {event has no name}
117 if FEvent = 0 then
118 raise Exception.CreateFmt('TTimerThread.Create: could not create API event
119 handle. 'Syserrormessage( GetLastError ) ] );
120 {thread will stay suspended until started by a Sleep or Resume call}
121 FState := wsIdle;
122 FNoWakeupEvent := False;
123 end;
124
125 destructor TTimerThread.Destroy;
126 begin
127 inherited;
128 if FEvent <> 0 then
129 CloseHandle(FEvent);
130 end;
131
132 procedure TTimerThread.DoWakeup;
133 begin
134 {called in threads context to fire OnWakeup event}
135 if Assigned(FWakeupEvent) and not FNoWakeupEvent then
136 Synchronize(SyncWakeup);
137 end;
138
139 procedure TTimerThread.Execute;
140 var
141 res: DWORD;
142 begin
143 {Executes inside threads context}
144 repeat
145 Fstate := wsWaiting;
146 res := WaitForSingleObject(FEvent, FInterval);
147 if res = WAIT_OBJECT_0 then
148 begin
149 FReason := wkEventTriggered;
150 ResetEvent(FEvent);
151 end
152 else
153 FReason := wkTimerExpired;
154 DoWakeup;
155 if not Terminated then
156 begin
157 Fstate := wsIdle;
158 Suspend;
159 end;
160 until
161 Terminated;
162 end;
163
164 procedure TTimerThread.Sleep(forInterval: DWORD);
165 begin
166 {called from outside threads context to start thread sleeping}
167 Interval := forInterval;
168 if State <> wsIdle then
169 begin
170 {thread is already waiting. Wake it up but disable wakeup event}
171 FNoWakeupEvent := true;
172 try
173 Wakeup;
174 while State = wsWaiting do
175 Windows.Sleep(10);
176 finally
177 FNoWakeupEvent := false;
178 end;
179 end;
180 Resume;
181 end;
182
183 procedure TTimerThread.SyncWakeup;
184 begin
185 {executes in main threads context}
186 {Note: FWakeupevent has already been checked to be <> nil in DoWakeup}
187 FWakeupEvent(self, FReason);
188 end;
189
190 procedure TTimerThread.Terminate;
191 begin
192 inherited Terminate;
193 {in case thread is waiting, don't fire Wakeup event on wakeup}
194 FNoWakeupEvent := true;
195 Wakeup;
196 end;
197
198 procedure TTimerThread.Wakeup;
199 begin
200 {executes in callers thread context}
201 if State = wsWaiting then
202 SetEvent(FEvent);
203 end;
204
205 end.
|
