I took a look at OmniThreadLibrary and it looked like overkill for my purposes.

I wrote a simple library I call TCommThread.

It allows you to pass data back to the main thread without worrying about

any of the complexities of threads or Windows messages.

Here's the code if you'd like to try it.

CommThread Library:

 

1 unit Threading.CommThread;  2   3 interface  4   5 uses  6   Classes, SysUtils, ExtCtrls, SyncObjs, Generics.Collections, DateUtils;  7   8 const  9   CTID_USER = 1000; 10   PRM_USER = 1000; 11  12   CTID_STATUS = 1; 13   CTID_PROGRESS = 2; 14  15 type 16   TThreadParams = class(TDictionary
     
      ); 17   TThreadObjects = class(TDictionary
      
       ); 18  19   TCommThreadParams = class(TObject) 20   private 21     FThreadParams: TThreadParams; 22     FThreadObjects: TThreadObjects; 23   public 24     constructor Create; 25     destructor Destroy; override; 26  27     procedure Clear; 28  29     function GetParam(const ParamName: String): Variant; 30     function SetParam(const ParamName: String; ParamValue: Variant): TCommThreadParams; 31     function GetObject(const ObjectName: String): TObject; 32     function SetObject(const ObjectName: String; Obj: TObject): TCommThreadParams; 33   end; 34  35   TCommQueueItem = class(TObject) 36   private 37     FSender: TObject; 38     FMessageId: Integer; 39     FCommThreadParams: TCommThreadParams; 40   public 41     destructor Destroy; override; 42  43     property Sender: TObject read FSender write FSender; 44     property MessageId: Integer read FMessageId write FMessageId; 45     property CommThreadParams: TCommThreadParams read FCommThreadParams write FCommThreadParams; 46   end; 47  48   TCommQueue = class(TQueue
       
        ); 49  50   ICommDispatchReceiver = interface 51     ['{A4E2C9D1-E4E8-497D-A9BF-FAFE2D3A7C49}'] 52     procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); 53     procedure CommThreadTerminated(Sender: TObject); 54     function Cancelled: Boolean; 55   end; 56  57   TCommThread = class(TThread) 58   protected 59     FCommThreadParams: TCommThreadParams; 60     FCommDispatchReceiver: ICommDispatchReceiver; 61     FName: String; 62     FProgressFrequency: Integer; 63     FNextSendTime: TDateTime; 64  65     procedure SendStatusMessage(const StatusText: String; StatusType: Integer = 0); virtual; 66     procedure SendProgressMessage(ProgressID: Int64; Progress, ProgressMax: Integer; AlwaysSend: Boolean = TRUE); virtual; 67   public 68     constructor Create(CommDispatchReceiver: TObject); reintroduce; virtual; 69     destructor Destroy; override; 70  71     function SetParam(const ParamName: String; ParamValue: Variant): TCommThread; 72     function GetParam(const ParamName: String): Variant; 73     function SetObject(const ObjectName: String; Obj: TObject): TCommThread; 74     function GetObject(const ObjectName: String): TObject; 75     procedure SendCommMessage(MessageId: Integer; CommThreadParams: TCommThreadParams); virtual; 76  77     property Name: String read FName; 78   end; 79  80   TCommThreadClass = Class of TCommThread; 81  82   TCommThreadQueue = class(TObjectList
        
         ); 83  84   TCommThreadDispatchState = ( 85     ctsIdle, 86     ctsActive, 87     ctsTerminating 88   ); 89  90   TOnReceiveThreadMessage = procedure(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams) of object; 91   TOnStateChange = procedure(Sender: TObject; State: TCommThreadDispatchState) of object; 92   TOnStatus = procedure(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer) of object; 93   TOnProgress = procedure(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer) of object; 94  95   TBaseCommThreadDispatch = class(TComponent, ICommDispatchReceiver) 96   private 97     FProcessQueueTimer: TTimer; 98     FCSReceiveMessage: TCriticalSection; 99     FCSCommThreads: TCriticalSection;100     FCommQueue: TCommQueue;101     FActiveThreads: TList;102     FCommThreadClass: TCommThreadClass;103     FCommThreadDispatchState: TCommThreadDispatchState;104 105     function CreateThread(const ThreadName: String = ''): TCommThread;106     function GetActiveThreadCount: Integer;107     function GetStateText: String;108   protected109     FOnReceiveThreadMessage: TOnReceiveThreadMessage;110     FOnStateChange: TOnStateChange;111     FOnStatus: TOnStatus;112     FOnProgress: TOnProgress;113     FManualMessageQueue: Boolean;114     FProgressFrequency: Integer;115 116     procedure SetManualMessageQueue(const Value: Boolean);117     procedure SetProcessQueueTimerInterval(const Value: Integer);118     procedure SetCommThreadDispatchState(const Value: TCommThreadDispatchState);119     procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);120     procedure OnProcessQueueTimer(Sender: TObject);121     function GetProcessQueueTimerInterval: Integer;122 123     procedure CommThreadTerminated(Sender: TObject); virtual;124     function Finished: Boolean; virtual;125 126     procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); virtual;127     procedure DoOnStateChange; virtual;128 129     procedure TerminateActiveThreads;130 131     property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;132     property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;133     property OnStatus: TOnStatus read FOnStatus write FOnStatus;134     property OnProgress: TOnProgress read FOnProgress write FOnProgress;135 136     property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;137     property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;138     property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;139     property CommThreadDispatchState: TCommThreadDispatchState read FCommThreadDispatchState write SetCommThreadDispatchState;140   public141     constructor Create(AOwner: TComponent); override;142     destructor Destroy; override;143 144     function NewThread(const ThreadName: String = ''): TCommThread; virtual;145     procedure ProcessMessageQueue; virtual;146     procedure Stop; virtual;147     function State: TCommThreadDispatchState;148     function Cancelled: Boolean;149 150     property ActiveThreadCount: Integer read GetActiveThreadCount;151     property StateText: String read GetStateText;152 153     property CommThreadClass: TCommThreadClass read FCommThreadClass write FCommThreadClass;154   end;155 156   TCommThreadDispatch = class(TBaseCommThreadDispatch)157   published158     property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;159     property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;160 161     property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;162     property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;163     property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;164   end;165 166   TBaseStatusCommThreadDispatch = class(TBaseCommThreadDispatch)167   protected168     FOnStatus: TOnStatus;169     FOnProgress: TOnProgress;170 171     procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;172 173     procedure DoOnStatus(Sender: TObject;const ID: String; const StatusText: String; StatusType: Integer); virtual;174     procedure DoOnProgress(Sender: TObject; const ID: String; Progress, ProgressMax: Integer); virtual;175 176     property OnStatus: TOnStatus read FOnStatus write FOnStatus;177     property OnProgress: TOnProgress read FOnProgress write FOnProgress;178   end;179 180   TStatusCommThreadDispatch = class(TBaseStatusCommThreadDispatch)181   published182     property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;183     property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;184     property OnStatus: TOnStatus read FOnStatus write FOnStatus;185     property OnProgress: TOnProgress read FOnProgress write FOnProgress;186 187     property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;188     property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;189     property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;190   end;191 192 implementation193 194 const195   PRM_STATUS_TEXT = 'Status';196   PRM_STATUS_TYPE = 'Type';197   PRM_PROGRESS_ID = 'ProgressID';198   PRM_PROGRESS = 'Progess';199   PRM_PROGRESS_MAX = 'ProgressMax';200 201 resourcestring202   StrCommReceiverMustSupportInterface = 'CommDispatchReceiver must support ICommDispatchReceiver interface';203   StrSenderMustBeATCommThread = 'Sender must be a TCommThread';204   StrUnableToFindTerminatedThread = 'Unable to find the terminated thread';205   StrIdle = 'Idle';206   StrTerminating = 'Terminating';207   StrActive = 'Active';208 209 {
     TCommThread }210 211 constructor TCommThread.Create(CommDispatchReceiver: TObject);212 begin213   Assert(Supports(CommDispatchReceiver, ICommDispatchReceiver, FCommDispatchReceiver), StrCommReceiverMustSupportInterface);214 215   inherited Create(TRUE);216 217   FCommThreadParams := TCommThreadParams.Create;218 end;219 220 destructor TCommThread.Destroy;221 begin222   FCommDispatchReceiver.CommThreadTerminated(Self);223 224   FreeAndNil(FCommThreadParams);225 226   inherited;227 end;228 229 function TCommThread.GetObject(const ObjectName: String): TObject;230 begin231   Result := FCommThreadParams.GetObject(ObjectName);232 end;233 234 function TCommThread.GetParam(const ParamName: String): Variant;235 begin236   Result := FCommThreadParams.GetParam(ParamName);237 end;238 239 procedure TCommThread.SendCommMessage(MessageId: Integer;240   CommThreadParams: TCommThreadParams);241 begin242   FCommDispatchReceiver.QueueMessage(Self, MessageId, CommThreadParams);243 end;244 245 procedure TCommThread.SendProgressMessage(ProgressID: Int64; Progress,246   ProgressMax: Integer; AlwaysSend: Boolean);247 begin248   if (AlwaysSend) or (now > FNextSendTime) then249   begin250     // Send a status message to the comm receiver251     SendCommMessage(CTID_PROGRESS, TCommThreadParams.Create252       .SetParam(PRM_PROGRESS_ID, ProgressID)253       .SetParam(PRM_PROGRESS, Progress)254       .SetParam(PRM_PROGRESS_MAX, ProgressMax));255 256     if not AlwaysSend then257       FNextSendTime := now + (FProgressFrequency * OneMillisecond);258   end;259 end;260 261 procedure TCommThread.SendStatusMessage(const StatusText: String;262   StatusType: Integer);263 begin264   // Send a status message to the comm receiver265   SendCommMessage(CTID_STATUS, TCommThreadParams.Create266     .SetParam(PRM_STATUS_TEXT, StatusText)267     .SetParam(PRM_STATUS_TYPE, StatusType));268 end;269 270 function TCommThread.SetObject(const ObjectName: String;271   Obj: TObject): TCommThread;272 begin273   Result := Self;274 275   FCommThreadParams.SetObject(ObjectName, Obj);276 end;277 278 function TCommThread.SetParam(const ParamName: String;279   ParamValue: Variant): TCommThread;280 begin281   Result := Self;282 283   FCommThreadParams.SetParam(ParamName, ParamValue);284 end;285 286 287 {
     TCommThreadDispatch }288 289 function TBaseCommThreadDispatch.Cancelled: Boolean;290 begin291   Result := State = ctsTerminating;292 end;293 294 procedure TBaseCommThreadDispatch.CommThreadTerminated(Sender: TObject);295 var296   idx: Integer;297 begin298   FCSCommThreads.Enter;299   try300     Assert(Sender is TCommThread, StrSenderMustBeATCommThread);301 302     // Find the thread in the active thread list303     idx := FActiveThreads.IndexOf(Sender);304 305     Assert(idx <> -1, StrUnableToFindTerminatedThread);306 307     // if we find it, remove it (we should always find it)308     FActiveThreads.Delete(idx);309   finally310     FCSCommThreads.Leave;311   end;312 end;313 314 constructor TBaseCommThreadDispatch.Create(AOwner: TComponent);315 begin316   inherited;317 318   FCommThreadClass := TCommThread;319 320   FProcessQueueTimer := TTimer.Create(nil);321   FProcessQueueTimer.Enabled := FALSE;322   FProcessQueueTimer.Interval := 5;323   FProcessQueueTimer.OnTimer := OnProcessQueueTimer;324   FProgressFrequency := 200;325 326   FCommQueue := TCommQueue.Create;327 328   FActiveThreads := TList.Create;329 330   FCSReceiveMessage := TCriticalSection.Create;331   FCSCommThreads := TCriticalSection.Create;332 end;333 334 destructor TBaseCommThreadDispatch.Destroy;335 begin336   // Stop the queue timer337   FProcessQueueTimer.Enabled := FALSE;338 339   TerminateActiveThreads;340 341   // Pump the queue while there are active threads342   while CommThreadDispatchState <> ctsIdle do343   begin344     ProcessMessageQueue;345 346     sleep(10);347   end;348 349   // Free everything350   FreeAndNil(FProcessQueueTimer);351   FreeAndNil(FCommQueue);352   FreeAndNil(FCSReceiveMessage);353   FreeAndNil(FCSCommThreads);354   FreeAndNil(FActiveThreads);355 356   inherited;357 end;358 359 procedure TBaseCommThreadDispatch.DoOnReceiveThreadMessage(Sender: TObject;360   MessageId: Integer; CommThreadParams: TCommThreadParams);361 begin362   // Don't send the messages if we're being destroyed363   if not (csDestroying in ComponentState) then364   begin365     if Assigned(FOnReceiveThreadMessage) then366       FOnReceiveThreadMessage(Self, Sender, MessageId, CommThreadParams);367   end;368 end;369 370 procedure TBaseCommThreadDispatch.DoOnStateChange;371 begin372   if (Assigned(FOnStateChange)) and (not (csDestroying in ComponentState)) then373     FOnStateChange(Self, FCommThreadDispatchState);374 end;375 376 function TBaseCommThreadDispatch.GetActiveThreadCount: Integer;377 begin378   Result := FActiveThreads.Count;379 end;380 381 function TBaseCommThreadDispatch.GetProcessQueueTimerInterval: Integer;382 begin383   Result := FProcessQueueTimer.Interval;384 end;385 386 387 function TBaseCommThreadDispatch.GetStateText: String;388 begin389   case State of390     ctsIdle: Result := StrIdle;391     ctsTerminating: Result := StrTerminating;392     ctsActive: Result := StrActive;393   end;394 end;395 396 function TBaseCommThreadDispatch.NewThread(const ThreadName: String): TCommThread;397 begin398   if FCommThreadDispatchState = ctsTerminating then399     Result := nil400   else401   begin402     // Make sure we're active403     if CommThreadDispatchState = ctsIdle then404       CommThreadDispatchState := ctsActive;405 406     Result := CreateThread(ThreadName);407 408     FActiveThreads.Add(Result);409 410     if ThreadName = '' then411       Result.FName := IntToStr(Integer(Result))412     else413       Result.FName := ThreadName;414 415     Result.FProgressFrequency := FProgressFrequency;416   end;417 end;418 419 function TBaseCommThreadDispatch.CreateThread(420   const ThreadName: String): TCommThread;421 begin422   Result := FCommThreadClass.Create(Self);423 424   Result.FreeOnTerminate := TRUE;425 end;426 427 procedure TBaseCommThreadDispatch.OnProcessQueueTimer(Sender: TObject);428 begin429   ProcessMessageQueue;430 end;431 432 procedure TBaseCommThreadDispatch.ProcessMessageQueue;433 var434   CommQueueItem: TCommQueueItem;435 begin436   if FCommThreadDispatchState in [ctsActive, ctsTerminating] then437   begin438     if FCommQueue.Count > 0 then439     begin440       FCSReceiveMessage.Enter;441       try442         CommQueueItem := FCommQueue.Dequeue;443 444         while Assigned(CommQueueItem) do445         begin446           try447             DoOnReceiveThreadMessage(CommQueueItem.Sender, CommQueueItem.MessageId, CommQueueItem.CommThreadParams);448           finally449             FreeAndNil(CommQueueItem);450           end;451 452           if FCommQueue.Count > 0 then453             CommQueueItem := FCommQueue.Dequeue;454         end;455       finally456         FCSReceiveMessage.Leave457       end;458     end;459 460     if Finished then461     begin462       FCommThreadDispatchState := ctsIdle;463 464       DoOnStateChange;465     end;466   end;467 end;468 469 function TBaseCommThreadDispatch.Finished: Boolean;470 begin471   Result := FActiveThreads.Count = 0;472 end;473 474 procedure TBaseCommThreadDispatch.QueueMessage(Sender: TObject; MessageId: Integer;475   CommThreadParams: TCommThreadParams);476 var477   CommQueueItem: TCommQueueItem;478 begin479   FCSReceiveMessage.Enter;480   try481     CommQueueItem := TCommQueueItem.Create;482     CommQueueItem.Sender := Sender;483     CommQueueItem.MessageId := MessageId;484     CommQueueItem.CommThreadParams := CommThreadParams;485 486     FCommQueue.Enqueue(CommQueueItem);487   finally488     FCSReceiveMessage.Leave489   end;490 end;491 492 procedure TBaseCommThreadDispatch.SetCommThreadDispatchState(493   const Value: TCommThreadDispatchState);494 begin495   if FCommThreadDispatchState <> ctsTerminating then496   begin497     if Value = ctsActive then498     begin499       if not FManualMessageQueue then500         FProcessQueueTimer.Enabled := TRUE;501     end502     else503       TerminateActiveThreads;504   end;505 506   FCommThreadDispatchState := Value;507 508   DoOnStateChange;509 end;510 511 procedure TBaseCommThreadDispatch.SetManualMessageQueue(const Value: Boolean);512 begin513   FManualMessageQueue := Value;514 end;515 516 procedure TBaseCommThreadDispatch.SetProcessQueueTimerInterval(const Value: Integer);517 begin518   FProcessQueueTimer.Interval := Value;519 end;520 521 function TBaseCommThreadDispatch.State: TCommThreadDispatchState;522 begin523   Result := FCommThreadDispatchState;524 end;525 526 procedure TBaseCommThreadDispatch.Stop;527 begin528   if CommThreadDispatchState = ctsActive then529     TerminateActiveThreads;530 end;531 532 procedure TBaseCommThreadDispatch.TerminateActiveThreads;533 var534   i: Integer;535 begin536   if FCommThreadDispatchState = ctsActive then537   begin538     // Lock threads539     FCSCommThreads.Acquire;540     try541       FCommThreadDispatchState := ctsTerminating;542 543       DoOnStateChange;544 545       // Terminate each thread in turn546       for i := 0 to pred(FActiveThreads.Count) do547         TCommThread(FActiveThreads[i]).Terminate;548     finally549       FCSCommThreads.Release;550     end;551   end;552 end;553 554 555 {
     TCommThreadParams }556 557 procedure TCommThreadParams.Clear;558 begin559   FThreadParams.Clear;560   FThreadObjects.Clear;561 end;562 563 constructor TCommThreadParams.Create;564 begin565   FThreadParams := TThreadParams.Create;566   FThreadObjects := TThreadObjects.Create;567 end;568 569 destructor TCommThreadParams.Destroy;570 begin571   FreeAndNil(FThreadParams);572   FreeAndNil(FThreadObjects);573 574   inherited;575 end;576 577 function TCommThreadParams.GetObject(const ObjectName: String): TObject;578 begin579   Result := FThreadObjects.Items[ObjectName];580 end;581 582 function TCommThreadParams.GetParam(const ParamName: String): Variant;583 begin584   Result := FThreadParams.Items[ParamName];585 end;586 587 function TCommThreadParams.SetObject(const ObjectName: String;588   Obj: TObject): TCommThreadParams;589 begin590   FThreadObjects.AddOrSetValue(ObjectName, Obj);591 592   Result := Self;593 end;594 595 function TCommThreadParams.SetParam(const ParamName: String;596   ParamValue: Variant): TCommThreadParams;597 begin598   FThreadParams.AddOrSetValue(ParamName, ParamValue);599 600   Result := Self;601 end;602 603 {
     TCommQueueItem }604 605 destructor TCommQueueItem.Destroy;606 begin607   if Assigned(FCommThreadParams) then608     FreeAndNil(FCommThreadParams);609 610   inherited;611 end;612 613 614 {
     TBaseStatusCommThreadDispatch }615 616 procedure TBaseStatusCommThreadDispatch.DoOnReceiveThreadMessage(617   Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);618 begin619   inherited;620 621   case MessageId of622     // Status Message623     CTID_STATUS: DoOnStatus(Sender,624                             Name,625                             CommThreadParams.GetParam(PRM_STATUS_TEXT),626                             CommThreadParams.GetParam(PRM_STATUS_TYPE));627     // Progress Message628     CTID_PROGRESS: DoOnProgress(Sender,629                                 CommThreadParams.GetParam(PRM_PROGRESS_ID),630                                 CommThreadParams.GetParam(PRM_PROGRESS),631                                 CommThreadParams.GetParam(PRM_PROGRESS_MAX));632   end;633 end;634 635 procedure TBaseStatusCommThreadDispatch.DoOnStatus(Sender: TObject; const ID,636   StatusText: String; StatusType: Integer);637 begin638   if (not (csDestroying in ComponentState)) and (Assigned(FOnStatus)) then639     FOnStatus(Self, Sender, ID, StatusText, StatusType);640 end;641 642 procedure TBaseStatusCommThreadDispatch.DoOnProgress(Sender: TObject;643   const ID: String; Progress, ProgressMax: Integer);644 begin645   if not (csDestroying in ComponentState) and (Assigned(FOnProgress)) then646     FOnProgress(Self, Sender, ID, Progress, ProgressMax);647 end;648 649 end.
        
       
      
     

To use the library, simply descend your thread from the TCommThread thread and override the Execute procedure: 

MyCommThreadObject = class(TCommThread)public  procedure Execute; override;end;

Next, create a descendant of the TStatusCommThreadDispatch component and set it's events. 

MyCommThreadComponent := TStatusCommThreadDispatch.Create(Self);  // Add the event handlers  MyCommThreadComponent.OnStateChange := OnStateChange;  MyCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage;  MyCommThreadComponent.OnStatus := OnStatus;  MyCommThreadComponent.OnProgress := OnProgress;  // Set the thread class  MyCommThreadComponent.CommThreadClass := TMyCommThread;

 

Make sure you set the CommThreadClass to your TCommThread descendant.

Now all you need to do is create the threads via MyCommThreadComponent:

FCommThreadComponent.NewThread    .SetParam('MyThreadInputParameter', '12345')    .SetObject('MyThreadInputObject', MyObject)    .Start;

 

Add as many parameters and objects as you like. In your threads Execute method you can retrieve the parameters and objects.

MyThreadParameter := GetParam('MyThreadInputParameter'); // 12345MyThreadObject := GetObject('MyThreadInputObject'); // MyObject

Parameters will be automatically freed. You need to manage objects yourself.

To send a message back to the main thread from the threads execute method:

FCommDispatchReceiver.QueueMessage(Self, CTID_MY_MESSAGE_ID, TCommThreadParams.Create  .SetObject('MyThreadObject', MyThreadObject)  .SetParam('MyThreadOutputParameter', MyThreadParameter));

Again, parameters will be destroyed automatically, objects you have to manage yourself.

 

To receive messages in the main thread either attach the OnReceiveThreadMessage event

or override the DoOnReceiveThreadMessage procedure:

procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;

 

Use the overridden procedure to process the messages sent back to your main thread:

procedure THostDiscovery.DoOnReceiveThreadMessage(Sender: TObject;  MessageId: Integer; CommThreadParams: TCommThreadParams);begin  inherited;  case MessageId of    CTID_MY_MESSAGE_ID:      begin        // Process the CTID_MY_MESSAGE_ID message        DoSomethingWithTheMessage(CommThreadParams.GetParam('MyThreadOutputParameter'),                                  CommThreadParams.GeObject('MyThreadObject'));      end;  end;end;

The messages are pumped in the ProcessMessageQueue procedure.

This procedure is called via a TTimer.

If you use the component in a console app you will need to call ProcessMessageQueue manually.

The timer will start when the first thread is created.

It will stop when the last thread has finished.

If you need to control when the timer stops you can override the Finished procedure.

You can also perform actions depending on the state of the threads by overriding the DoOnStateChange procedure.

Take a look at the TCommThread descendant TStatusCommThreadDispatch.

It implements the sending of simple Status and Progress messages back to the main thread.

I hope this helps and that I've explained it OK.

 

This is related to my previous answer, but I was limited to 30000 characters.

Here's the code for a test app that uses TCommThread:

Test App (.pas)

unit frmMainU;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ComCtrls, ExtCtrls, StdCtrls,  Threading.CommThread;type  TMyCommThread = class(TCommThread)  public    procedure Execute; override;  end;  TfrmMain = class(TForm)    Panel1: TPanel;    lvLog: TListView;    btnStop: TButton;    btnNewThread: TButton;    StatusBar1: TStatusBar;    btn30NewThreads: TButton;    tmrUpdateStatusBar: TTimer;    procedure FormCreate(Sender: TObject);    procedure btnStopClick(Sender: TObject);    procedure Button3Click(Sender: TObject);    procedure Button4Click(Sender: TObject);    procedure tmrUpdateStatusBarTimer(Sender: TObject);  private    FCommThreadComponent: TStatusCommThreadDispatch;    procedure OnReceiveThreadMessage(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);    procedure OnStateChange(Sender: TObject; State: TCommThreadDispatchState);    procedure UpdateStatusBar;    procedure OnStatus(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer);    procedure OnProgress(Source, Sender: TObject; const ID: String; Progress,  ProgressMax: Integer);  public  end;var  frmMain: TfrmMain;implementationresourcestring  StrStatusIDDProgre = 'StatusID: %s, Progress: %d, ProgressMax: %d';  StrActiveThreadsD = 'Active Threads: %d, State: %s';  StrIdle = 'Idle';  StrActive = 'Active';  StrTerminating = 'Terminating';{
    $R *.dfm}{
     TMyCommThread }procedure TMyCommThread.Execute;var  i: Integer;begin  SendCommMessage(0, TCommThreadParams.Create.SetParam('status', 'started'));  for i := 0 to 40 do  begin    sleep(50);    SendStatusMessage(format('Thread: %s, i = %d', [Name, i]), 1);    if Terminated then      Break;    sleep(50);    SendProgressMessage(Integer(Self), i, 40, FALSE);  end;  if Terminated then    SendCommMessage(0, TCommThreadParams.Create.SetParam('status', 'terminated'))  else    SendCommMessage(0, TCommThreadParams.Create.SetParam('status', 'finished'));end;{
     TfrmMain }procedure TfrmMain.btnStopClick(Sender: TObject);begin  FCommThreadComponent.Stop;end;procedure TfrmMain.Button3Click(Sender: TObject);var  i: Integer;begin  for i := 0 to 29 do    FCommThreadComponent.NewThread      .SetParam('input_param1', 'test_value')      .Start;end;procedure TfrmMain.Button4Click(Sender: TObject);begin  FCommThreadComponent.NewThread    .SetParam('input_param1', 'test_value')    .Start;end;procedure TfrmMain.FormCreate(Sender: TObject);begin  FCommThreadComponent := TStatusCommThreadDispatch.Create(Self);  // Add the event handlers  FCommThreadComponent.OnStateChange := OnStateChange;  FCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage;  FCommThreadComponent.OnStatus := OnStatus;  FCommThreadComponent.OnProgress := OnProgress;  // Set the thread class  FCommThreadComponent.CommThreadClass := TMyCommThread;end;procedure TfrmMain.OnProgress(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer);begin  With lvLog.Items.Add do  begin    Caption := '-';    SubItems.Add(format(StrStatusIDDProgre, [Id, Progress, ProgressMax]));  end;end;procedure TfrmMain.OnReceiveThreadMessage(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);begin  if MessageID = 0 then    With lvLog.Items.Add do    begin      Caption := IntToStr(MessageId);      SubItems.Add(CommThreadParams.GetParam('status'));    end;end;procedure TfrmMain.UpdateStatusBar;begin  StatusBar1.SimpleText := format(StrActiveThreadsD, [FCommThreadComponent.ActiveThreadCount, FCommThreadComponent.StateText]);end;procedure TfrmMain.OnStateChange(Sender: TObject; State: TCommThreadDispatchState);begin  With lvLog.Items.Add do  begin    case State of      ctsIdle: Caption := StrIdle;      ctsActive: Caption := StrActive;      ctsTerminating: Caption := StrTerminating;    end;  end;end;procedure TfrmMain.OnStatus(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer);begin  With lvLog.Items.Add do  begin    Caption := IntToStr(StatusType);    SubItems.Add(StatusText);  end;end;procedure TfrmMain.tmrUpdateStatusBarTimer(Sender: TObject);begin  UpdateStatusBar;end;end.

Test app (.dfm)

 

object frmMain: TfrmMain  Left = 0  Top = 0  Caption = 'CommThread Test'  ClientHeight = 290  ClientWidth = 557  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'Tahoma'  Font.Style = []  OldCreateOrder = False  OnCreate = FormCreate  PixelsPerInch = 96  TextHeight = 13  object Panel1: TPanel    AlignWithMargins = True    Left = 3    Top = 3    Width = 97    Height = 265    Margins.Right = 0    Align = alLeft    BevelOuter = bvNone    TabOrder = 0    object btnStop: TButton      AlignWithMargins = True      Left = 0      Top = 60      Width = 97      Height = 25      Margins.Left = 0      Margins.Top = 10      Margins.Right = 0      Margins.Bottom = 0      Align = alTop      Caption = 'Stop'      TabOrder = 2      OnClick = btnStopClick    end    object btnNewThread: TButton      Left = 0      Top = 0      Width = 97      Height = 25      Align = alTop      Caption = 'New Thread'      TabOrder = 0      OnClick = Button4Click    end    object btn30NewThreads: TButton      Left = 0      Top = 25      Width = 97      Height = 25      Align = alTop      Caption = '30 New Threads'      TabOrder = 1      OnClick = Button3Click    end  end  object lvLog: TListView    AlignWithMargins = True    Left = 103    Top = 3    Width = 451    Height = 265    Align = alClient    Columns = <      item        Caption = 'Message ID'        Width = 70      end      item        AutoSize = True        Caption = 'Info'      end>    ReadOnly = True    RowSelect = True    TabOrder = 1    ViewStyle = vsReport  end  object StatusBar1: TStatusBar    Left = 0    Top = 271    Width = 557    Height = 19    Panels = <>    SimplePanel = True  end  object tmrUpdateStatusBar: TTimer    Interval = 200    OnTimer = tmrUpdateStatusBarTimer    Left = 272    Top = 152  endend