How to create user-defined messages in a TThread (Views: 710)
Problem/Question/Abstract: 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: {Writing an interruptible timer thread} unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls; type TTimerThread = class; TWakeupKind = (wkTimerExpired, wkEventTriggered); TWaitState = (wsIdle, wsWaiting); TWakeupEvent = procedure(sender: TTimerThread; reason: TWakeupKind) of object; TTimerThread = class(TThread) private FInterval: DWORD; FReason: TWakeupKind; FEvent: THandle; FState: TwaitState; FWakeupEvent: TWakeupEvent; FNoWakeupEvent: Boolean; procedure SyncWakeup; protected procedure DoWakeup; public constructor Create; reintroduce; destructor Destroy; override; procedure Execute; override; procedure Sleep(forInterval: DWORD); procedure Wakeup; procedure Terminate; property OnWakeup: TWakeupEvent read FWakeupEvent write FWakeupEvent; property Interval: DWORD read FInterval write FInterval; property State: TWaitState read FState; end; {TTimerThread} TForm1 = class(TForm) StatusBar: TStatusBar; WaitButton: TButton; OpenDialog1: TOpenDialog; Label1: TLabel; WaitIntervalEdit: TEdit; WakeupButton: TButton; Memo1: TMemo; procedure WaitIntervalEditKeyPress(Sender: TObject; var Key: Char); procedure WaitButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure WakeupButtonClick(Sender: TObject); private { Private declarations } FTimerthread: TTimerThread; procedure TimerWakeup(sender: TTimerThread; reason: TWakeupKind); public { Public declarations } end; var Form1: TForm1; implementation uses typinfo; {$R *.DFM} procedure TForm1.WaitIntervalEditKeyPress(Sender: TObject; var Key: Char); begin if not (key in ['0'..'9', #8]) then Key := #0; end; procedure TForm1.WaitButtonClick(Sender: TObject); begin FTimerThread.Sleep(StrToInt(WaitIntervalEdit.Text)); memo1.lines.add('Timer started'); end; procedure TForm1.FormCreate(Sender: TObject); begin FTimerthread := TTimerThread.Create; FTimerthread.FreeOnTerminate := true; FTimerthread.OnWakeup := TimerWakeup; end; procedure TForm1.TimerWakeup(sender: TTimerThread; reason: TWakeupKind); begin memo1.lines.add('Timer woke up, reason: ' + GetEnumName(Typeinfo(TWakeupKind), Ord(reason))); end; procedure TForm1.FormDestroy(Sender: TObject); begin if Assigned(FTimerthread) then FTimerThread.Terminate; end; procedure TForm1.WakeupButtonClick(Sender: TObject); begin FTimerthread.Wakeup; end; { TTimerThread } constructor TTimerThread.Create; begin {create thread suspended} inherited Create(true); {create event object} FEvent := CreateEvent( nil, {use default security} true, {event will be manually reset} false, {event starts out not signaled} nil); {event has no name} if FEvent = 0 then raise Exception.CreateFmt('TTimerThread.Create: could not create API event handle. '#13#10' %s', [ Syserrormessage( GetLastError ) ] ); {thread will stay suspended until started by a Sleep or Resume call} FState := wsIdle; FNoWakeupEvent := False; end; destructor TTimerThread.Destroy; begin inherited; if FEvent <> 0 then CloseHandle(FEvent); end; procedure TTimerThread.DoWakeup; begin {called in threads context to fire OnWakeup event} if Assigned(FWakeupEvent) and not FNoWakeupEvent then Synchronize(SyncWakeup); end; procedure TTimerThread.Execute; var res: DWORD; begin {Executes inside threads context} repeat Fstate := wsWaiting; res := WaitForSingleObject(FEvent, FInterval); if res = WAIT_OBJECT_0 then begin FReason := wkEventTriggered; ResetEvent(FEvent); end else FReason := wkTimerExpired; DoWakeup; if not Terminated then begin Fstate := wsIdle; Suspend; end; until Terminated; end; procedure TTimerThread.Sleep(forInterval: DWORD); begin {called from outside threads context to start thread sleeping} Interval := forInterval; if State <> wsIdle then begin {thread is already waiting. Wake it up but disable wakeup event} FNoWakeupEvent := true; try Wakeup; while State = wsWaiting do Windows.Sleep(10); finally FNoWakeupEvent := false; end; end; Resume; end; procedure TTimerThread.SyncWakeup; begin {executes in main threads context} {Note: FWakeupevent has already been checked to be <> nil in DoWakeup} FWakeupEvent(self, FReason); end; procedure TTimerThread.Terminate; begin inherited Terminate; {in case thread is waiting, don't fire Wakeup event on wakeup} FNoWakeupEvent := true; Wakeup; end; procedure TTimerThread.Wakeup; begin {executes in callers thread context} if State = wsWaiting then SetEvent(FEvent); end; end. |