How to create user-defined messages in a TThread

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.