How to manage the return value of a thread?

Question

I created a class derived from TThread that executes in background a query.

I want that this class is decoupled from the client.

This kind of thread has the purpose of executing a simple check (like how many users are currently connected to the application, without blocking the UI), so a simple idea is to use the Synchronize Method.

Anyway since i want it to be decoupled i pass in the constructor a parameter of type

TSyncMethod: procedure of object;

Where TSyncMethod is a method on the client (a form in my case).

Anyway how can I pass the value to TSyncMethod? I should write the result on some "global place" and then inside my TSyncMethod I check for it?

I also tried to think of

TSyncMethod: procedure(ReturnValue: integer) of object;

but of course when I call Synchronize(MySyncMethod) I cannot pass parameters to it.

Answer 1

Create a form and add a ListBox , two Buttons, and edit your form. Then use this code:

unit Unit1;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

    type
      TSyncMethod = procedure(ReturnValue: integer) of object;
      TMyThread = class(TThread)
       private
          fLowerLimit: Integer;
          fUpperLimit: Integer;
          FMethod: TSyncMethod;
          FMethodValue: Integer;
          procedure UpdateMainThread;
       protected
          procedure Execute; override;
       public
          constructor Create(AMethod: TSyncMethod;lValue, uValue: Integer; Suspended: Boolean);
       end;



      TForm1 = class(TForm)
        Button1: TButton;
        Edit1: TEdit;
        Button2: TButton;
        ListBox1: TListBox;
        procedure Button2Click(Sender: TObject);
        procedure Button1Click(Sender: TObject);
      private
         MyMethod: TSyncMethod;
         ReturnValue : Integer;
         CountingThread: TMyThread;
         procedure MyTest(X : Integer);
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    constructor TMyThread.Create(AMethod: TSyncMethod;lValue, uValue: Integer; Suspended: Boolean);
    begin
       FMethod := AMethod;
       Inherited Create(Suspended);
       fLowerLimit := lValue;
       fUpperLimit := uValue;
       FreeOnTerminate := True;
       Priority := tpLowest;
    end;

    procedure TMyThread.Execute;
    var
       I: Integer;
    begin

       For I := fLowerLimit to fUpperLimit do
          if (I mod 10) = 0 then
             Synchronize(UpdateMainThread);

      FMethod(FMethodValue);
    end;

    procedure TMyThread.UpdateMainThread;
    begin
       Form1.ListBox1.Items.Add('Hello World');
       FMethodValue :=  Form1.ListBox1.Count;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
       MyMethod := MyTest;
       CountingThread := TMyThread.Create(MyMethod,22, 999, True);
       CountingThread.Resume;
    //   ShowMessage(IntToStr(ReturnValue));
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    begin
      ShowMessage(Edit1.Text);
    end;

    procedure TForm1.MyTest(X: Integer);
    begin
      ShowMessage(IntToStr(X));
    end;

    end.        

Answer 2

For such a simply example, you can put the desired value into a member field of the thread (or even into the thread's own ReturnValue property), then Synchronize() execution of the callback using an intermediate thread method, where you can then pass the value to the callback. For example:

type
  TSyncMethod: procedure(ReturnValue: integer) of object;

  TQueryUserConnected = class(TThread)
  private
    FMethod: TSyncMethod;
    FMethodValue: Integer;
    procedure DoSync;
  protected
    procedure Execute; override;
  public
    constructor Create(AMethod: TSyncMethod); reintroduce;
  end;

constructor TQueryUserConnected.Create(AMethod: TSyncMethod);
begin
  FMethod := AMethod;
  inherited Create(False);
end;

procedure TQueryUserConnected.Execute;
begin
  ...
  FMethodValue := ...;
  if FMethod <> nil then
    Synchronize(DoSync);
end;

procedure TQueryUserConnected.DoSync;
begin
  if FMethod <> nil then
    FMethod(FMethodValue);
end;

Answer 3

Using OmniThreadLibrary:

uses OtlFutures;

var
  thread: IOmniFuture<integer>;

thread := TOmniFuture<integer>.Create(
  function: integer;
  begin
    Result := YourFunction;
  end;
);
// do something else
threadRes := thread.Value; //will block if thread is not yet done

Creating the TOmniFuture object will automatically start background thread executing your code. Later you can wait on result by calling .Value or you can use .TryValue or .IsDone to check if the thread has already completed its work.

Answer 4

You can try my TCommThread component. 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. You can also see some example code here.

CommThread Library:

unit Threading.CommThread;

interface

uses
  Classes, SysUtils, ExtCtrls, SyncObjs, Generics.Collections, DateUtils;

const
  CTID_USER = 1000;
  PRM_USER = 1000;

  CTID_STATUS = 1;
  CTID_PROGRESS = 2;

type
  TThreadParams = class(TDictionary<String, Variant>);
  TThreadObjects = class(TDictionary<String, TObject>);

  TCommThreadParams = class(TObject)
  private
    FThreadParams: TThreadParams;
    FThreadObjects: TThreadObjects;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;

    function GetParam(const ParamName: String): Variant;
    function SetParam(const ParamName: String; ParamValue: Variant): TCommThreadParams;
    function GetObject(const ObjectName: String): TObject;
    function SetObject(const ObjectName: String; Obj: TObject): TCommThreadParams;
  end;

  TCommQueueItem = class(TObject)
  private
    FSender: TObject;
    FMessageId: Integer;
    FCommThreadParams: TCommThreadParams;
  public
    destructor Destroy; override;

    property Sender: TObject read FSender write FSender;
    property MessageId: Integer read FMessageId write FMessageId;
    property CommThreadParams: TCommThreadParams read FCommThreadParams write FCommThreadParams;
  end;

  TCommQueue = class(TQueue<TCommQueueItem>);

  ICommDispatchReceiver = interface
    ['{A4E2C9D1-E4E8-497D-A9BF-FAFE2D3A7C49}']
    procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
    procedure CommThreadTerminated(Sender: TObject);
    function Cancelled: Boolean;
  end;

  TCommThread = class(TThread)
  protected
    FCommThreadParams: TCommThreadParams;
    FCommDispatchReceiver: ICommDispatchReceiver;
    FName: String;
    FProgressFrequency: Integer;
    FNextSendTime: TDateTime;

    procedure SendStatusMessage(const StatusText: String; StatusType: Integer = 0); virtual;
    procedure SendProgressMessage(ProgressID: Int64; Progress, ProgressMax: Integer; AlwaysSend: Boolean = TRUE); virtual;
  public
    constructor Create(CommDispatchReceiver: TObject); reintroduce; virtual;
    destructor Destroy; override;

    function SetParam(const ParamName: String; ParamValue: Variant): TCommThread;
    function GetParam(const ParamName: String): Variant;
    function SetObject(const ObjectName: String; Obj: TObject): TCommThread;
    function GetObject(const ObjectName: String): TObject;
    procedure SendCommMessage(MessageId: Integer; CommThreadParams: TCommThreadParams); virtual;

    property Name: String read FName;
  end;

  TCommThreadClass = Class of TCommThread;

  TCommThreadQueue = class(TObjectList<TCommThread>);

  TCommThreadDispatchState = (
    ctsIdle,
    ctsActive,
    ctsTerminating
  );

  TOnReceiveThreadMessage = procedure(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams) of object;
  TOnStateChange = procedure(Sender: TObject; State: TCommThreadDispatchState) of object;
  TOnStatus = procedure(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer) of object;
  TOnProgress = procedure(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer) of object;

  TBaseCommThreadDispatch = class(TComponent, ICommDispatchReceiver)
  private
    FProcessQueueTimer: TTimer;
    FCSReceiveMessage: TCriticalSection;
    FCSCommThreads: TCriticalSection;
    FCommQueue: TCommQueue;
    FActiveThreads: TList;
    FCommThreadClass: TCommThreadClass;
    FCommThreadDispatchState: TCommThreadDispatchState;

    function CreateThread(const ThreadName: String = ''): TCommThread;
    function GetActiveThreadCount: Integer;
    function GetStateText: String;
  protected
    FOnReceiveThreadMessage: TOnReceiveThreadMessage;
    FOnStateChange: TOnStateChange;
    FOnStatus: TOnStatus;
    FOnProgress: TOnProgress;
    FManualMessageQueue: Boolean;
    FProgressFrequency: Integer;

    procedure SetManualMessageQueue(const Value: Boolean);
    procedure SetProcessQueueTimerInterval(const Value: Integer);
    procedure SetCommThreadDispatchState(const Value: TCommThreadDispatchState);
    procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
    procedure OnProcessQueueTimer(Sender: TObject);
    function GetProcessQueueTimerInterval: Integer;

    procedure CommThreadTerminated(Sender: TObject); virtual;
    function Finished: Boolean; virtual;

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

    procedure TerminateActiveThreads;

    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
    property CommThreadDispatchState: TCommThreadDispatchState read FCommThreadDispatchState write SetCommThreadDispatchState;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function NewThread(const ThreadName: String = ''): TCommThread; virtual;
    procedure ProcessMessageQueue; virtual;
    procedure Stop; virtual;
    function State: TCommThreadDispatchState;
    function Cancelled: Boolean;

    property ActiveThreadCount: Integer read GetActiveThreadCount;
    property StateText: String read GetStateText;

    property CommThreadClass: TCommThreadClass read FCommThreadClass write FCommThreadClass;
  end;

  TCommThreadDispatch = class(TBaseCommThreadDispatch)
  published
    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  end;

  TBaseStatusCommThreadDispatch = class(TBaseCommThreadDispatch)
  protected
    FOnStatus: TOnStatus;
    FOnProgress: TOnProgress;

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

    procedure DoOnStatus(Sender: TObject;const ID: String; const StatusText: String; StatusType: Integer); virtual;
    procedure DoOnProgress(Sender: TObject; const ID: String; Progress, ProgressMax: Integer); virtual;

    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
  end;

  TStatusCommThreadDispatch = class(TBaseStatusCommThreadDispatch)
  published
    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
    property OnStatus: TOnStatus read FOnStatus write FOnStatus;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  end;

implementation

const
  PRM_STATUS_TEXT = 'Status';
  PRM_STATUS_TYPE = 'Type';
  PRM_PROGRESS_ID = 'ProgressID';
  PRM_PROGRESS = 'Progess';
  PRM_PROGRESS_MAX = 'ProgressMax';

resourcestring
  StrCommReceiverMustSupportInterface = 'CommDispatchReceiver must support ICommDispatchReceiver interface';
  StrSenderMustBeATCommThread = 'Sender must be a TCommThread';
  StrUnableToFindTerminatedThread = 'Unable to find the terminated thread';
  StrIdle = 'Idle';
  StrTerminating = 'Terminating';
  StrActive = 'Active';

{ TCommThread }

constructor TCommThread.Create(CommDispatchReceiver: TObject);
begin
  Assert(Supports(CommDispatchReceiver, ICommDispatchReceiver, FCommDispatchReceiver), StrCommReceiverMustSupportInterface);

  inherited Create(TRUE);

  FCommThreadParams := TCommThreadParams.Create;
end;

destructor TCommThread.Destroy;
begin
  FCommDispatchReceiver.CommThreadTerminated(Self);

  FreeAndNil(FCommThreadParams);

  inherited;
end;

function TCommThread.GetObject(const ObjectName: String): TObject;
begin
  Result := FCommThreadParams.GetObject(ObjectName);
end;

function TCommThread.GetParam(const ParamName: String): Variant;
begin
  Result := FCommThreadParams.GetParam(ParamName);
end;

procedure TCommThread.SendCommMessage(MessageId: Integer;
  CommThreadParams: TCommThreadParams);
begin
  FCommDispatchReceiver.QueueMessage(Self, MessageId, CommThreadParams);
end;

procedure TCommThread.SendProgressMessage(ProgressID: Int64; Progress,
  ProgressMax: Integer; AlwaysSend: Boolean);
begin
  if (AlwaysSend) or (now > FNextSendTime) then
  begin
    // Send a status message to the comm receiver
    SendCommMessage(CTID_PROGRESS, TCommThreadParams.Create
      .SetParam(PRM_PROGRESS_ID, ProgressID)
      .SetParam(PRM_PROGRESS, Progress)
      .SetParam(PRM_PROGRESS_MAX, ProgressMax));

    if not AlwaysSend then
      FNextSendTime := now + (FProgressFrequency * OneMillisecond);
  end;
end;

procedure TCommThread.SendStatusMessage(const StatusText: String;
  StatusType: Integer);
begin
  // Send a status message to the comm receiver
  SendCommMessage(CTID_STATUS, TCommThreadParams.Create
    .SetParam(PRM_STATUS_TEXT, StatusText)
    .SetParam(PRM_STATUS_TYPE, StatusType));
end;

function TCommThread.SetObject(const ObjectName: String;
  Obj: TObject): TCommThread;
begin
  Result := Self;

  FCommThreadParams.SetObject(ObjectName, Obj);
end;

function TCommThread.SetParam(const ParamName: String;
  ParamValue: Variant): TCommThread;
begin
  Result := Self;

  FCommThreadParams.SetParam(ParamName, ParamValue);
end;


{ TCommThreadDispatch }

function TBaseCommThreadDispatch.Cancelled: Boolean;
begin
  Result := State = ctsTerminating;
end;

procedure TBaseCommThreadDispatch.CommThreadTerminated(Sender: TObject);
var
  idx: Integer;
begin
  FCSCommThreads.Enter;
  try
    Assert(Sender is TCommThread, StrSenderMustBeATCommThread);

    // Find the thread in the active thread list
    idx := FActiveThreads.IndexOf(Sender);

    Assert(idx <> -1, StrUnableToFindTerminatedThread);

    // if we find it, remove it (we should always find it)
    FActiveThreads.Delete(idx);
  finally
    FCSCommThreads.Leave;
  end;
end;

constructor TBaseCommThreadDispatch.Create(AOwner: TComponent);
begin
  inherited;

  FCommThreadClass := TCommThread;

  FProcessQueueTimer := TTimer.Create(nil);
  FProcessQueueTimer.Enabled := FALSE;
  FProcessQueueTimer.Interval := 5;
  FProcessQueueTimer.OnTimer := OnProcessQueueTimer;
  FProgressFrequency := 200;

  FCommQueue := TCommQueue.Create;

  FActiveThreads := TList.Create;

  FCSReceiveMessage := TCriticalSection.Create;
  FCSCommThreads := TCriticalSection.Create;
end;

destructor TBaseCommThreadDispatch.Destroy;
begin
  // Stop the queue timer
  FProcessQueueTimer.Enabled := FALSE;

  TerminateActiveThreads;

  // Pump the queue while there are active threads
  while CommThreadDispatchState <> ctsIdle do
  begin
    ProcessMessageQueue;

    sleep(10);
  end;

  // Free everything
  FreeAndNil(FProcessQueueTimer);
  FreeAndNil(FCommQueue);
  FreeAndNil(FCSReceiveMessage);
  FreeAndNil(FCSCommThreads);
  FreeAndNil(FActiveThreads);

  inherited;
end;

procedure TBaseCommThreadDispatch.DoOnReceiveThreadMessage(Sender: TObject;
  MessageId: Integer; CommThreadParams: TCommThreadParams);
begin
  // Don't send the messages if we're being destroyed
  if not (csDestroying in ComponentState) then
  begin
    if Assigned(FOnReceiveThreadMessage) then
      FOnReceiveThreadMessage(Self, Sender, MessageId, CommThreadParams);
  end;
end;

procedure TBaseCommThreadDispatch.DoOnStateChange;
begin
  if (Assigned(FOnStateChange)) and (not (csDestroying in ComponentState)) then
    FOnStateChange(Self, FCommThreadDispatchState);
end;

function TBaseCommThreadDispatch.GetActiveThreadCount: Integer;
begin
  Result := FActiveThreads.Count;
end;

function TBaseCommThreadDispatch.GetProcessQueueTimerInterval: Integer;
begin
  Result := FProcessQueueTimer.Interval;
end;


function TBaseCommThreadDispatch.GetStateText: String;
begin
  case State of
    ctsIdle: Result := StrIdle;
    ctsTerminating: Result := StrTerminating;
    ctsActive: Result := StrActive;
  end;
end;

function TBaseCommThreadDispatch.NewThread(const ThreadName: String): TCommThread;
begin
  if FCommThreadDispatchState = ctsTerminating then
    Result := nil
  else
  begin
    // Make sure we're active
    if CommThreadDispatchState = ctsIdle then
      CommThreadDispatchState := ctsActive;

    Result := CreateThread(ThreadName);

    FActiveThreads.Add(Result);

    if ThreadName = '' then
      Result.FName := IntToStr(Integer(Result))
    else
      Result.FName := ThreadName;

    Result.FProgressFrequency := FProgressFrequency;
  end;
end;

function TBaseCommThreadDispatch.CreateThread(
  const ThreadName: String): TCommThread;
begin
  Result := FCommThreadClass.Create(Self);

  Result.FreeOnTerminate := TRUE;
end;

procedure TBaseCommThreadDispatch.OnProcessQueueTimer(Sender: TObject);
begin
  ProcessMessageQueue;
end;

procedure TBaseCommThreadDispatch.ProcessMessageQueue;
var
  CommQueueItem: TCommQueueItem;
begin
  if FCommThreadDispatchState in [ctsActive, ctsTerminating] then
  begin
    if FCommQueue.Count > 0 then
    begin
      FCSReceiveMessage.Enter;
      try
        CommQueueItem := FCommQueue.Dequeue;

        while Assigned(CommQueueItem) do
        begin
          try
            DoOnReceiveThreadMessage(CommQueueItem.Sender, CommQueueItem.MessageId, CommQueueItem.CommThreadParams);
          finally
            FreeAndNil(CommQueueItem);
          end;

          if FCommQueue.Count > 0 then
            CommQueueItem := FCommQueue.Dequeue;
        end;
      finally
        FCSReceiveMessage.Leave
      end;
    end;

    if Finished then
    begin
      FCommThreadDispatchState := ctsIdle;

      DoOnStateChange;
    end;
  end;
end;

function TBaseCommThreadDispatch.Finished: Boolean;
begin
  Result := FActiveThreads.Count = 0;
end;

procedure TBaseCommThreadDispatch.QueueMessage(Sender: TObject; MessageId: Integer;
  CommThreadParams: TCommThreadParams);
var
  CommQueueItem: TCommQueueItem;
begin
  FCSReceiveMessage.Enter;
  try
    CommQueueItem := TCommQueueItem.Create;
    CommQueueItem.Sender := Sender;
    CommQueueItem.MessageId := MessageId;
    CommQueueItem.CommThreadParams := CommThreadParams;

    FCommQueue.Enqueue(CommQueueItem);
  finally
    FCSReceiveMessage.Leave
  end;
end;

procedure TBaseCommThreadDispatch.SetCommThreadDispatchState(
  const Value: TCommThreadDispatchState);
begin
  if FCommThreadDispatchState <> ctsTerminating then
  begin
    if Value = ctsActive then
    begin
      if not FManualMessageQueue then
        FProcessQueueTimer.Enabled := TRUE;
    end
    else
      TerminateActiveThreads;
  end;

  FCommThreadDispatchState := Value;

  DoOnStateChange;
end;

procedure TBaseCommThreadDispatch.SetManualMessageQueue(const Value: Boolean);
begin
  FManualMessageQueue := Value;
end;

procedure TBaseCommThreadDispatch.SetProcessQueueTimerInterval(const Value: Integer);
begin
  FProcessQueueTimer.Interval := Value;
end;

function TBaseCommThreadDispatch.State: TCommThreadDispatchState;
begin
  Result := FCommThreadDispatchState;
end;

procedure TBaseCommThreadDispatch.Stop;
begin
  if CommThreadDispatchState = ctsActive then
    TerminateActiveThreads;
end;

procedure TBaseCommThreadDispatch.TerminateActiveThreads;
var
  i: Integer;
begin
  if FCommThreadDispatchState = ctsActive then
  begin
    // Lock threads
    FCSCommThreads.Acquire;
    try
      FCommThreadDispatchState := ctsTerminating;

      DoOnStateChange;

      // Terminate each thread in turn
      for i := 0 to pred(FActiveThreads.Count) do
        TCommThread(FActiveThreads[i]).Terminate;
    finally
      FCSCommThreads.Release;
    end;
  end;
end;


{ TCommThreadParams }

procedure TCommThreadParams.Clear;
begin
  FThreadParams.Clear;
  FThreadObjects.Clear;
end;

constructor TCommThreadParams.Create;
begin
  FThreadParams := TThreadParams.Create;
  FThreadObjects := TThreadObjects.Create;
end;

destructor TCommThreadParams.Destroy;
begin
  FreeAndNil(FThreadParams);
  FreeAndNil(FThreadObjects);

  inherited;
end;

function TCommThreadParams.GetObject(const ObjectName: String): TObject;
begin
  Result := FThreadObjects.Items[ObjectName];
end;

function TCommThreadParams.GetParam(const ParamName: String): Variant;
begin
  Result := FThreadParams.Items[ParamName];
end;

function TCommThreadParams.SetObject(const ObjectName: String;
  Obj: TObject): TCommThreadParams;
begin
  FThreadObjects.AddOrSetValue(ObjectName, Obj);

  Result := Self;
end;

function TCommThreadParams.SetParam(const ParamName: String;
  ParamValue: Variant): TCommThreadParams;
begin
  FThreadParams.AddOrSetValue(ParamName, ParamValue);

  Result := Self;
end;

{ TCommQueueItem }

destructor TCommQueueItem.Destroy;
begin
  if Assigned(FCommThreadParams) then
    FreeAndNil(FCommThreadParams);

  inherited;
end;


{ TBaseStatusCommThreadDispatch }

procedure TBaseStatusCommThreadDispatch.DoOnReceiveThreadMessage(
  Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
begin
  inherited;

  case MessageId of
    // Status Message
    CTID_STATUS: DoOnStatus(Sender,
                            Name,
                            CommThreadParams.GetParam(PRM_STATUS_TEXT),
                            CommThreadParams.GetParam(PRM_STATUS_TYPE));
    // Progress Message
    CTID_PROGRESS: DoOnProgress(Sender,
                                CommThreadParams.GetParam(PRM_PROGRESS_ID),
                                CommThreadParams.GetParam(PRM_PROGRESS),
                                CommThreadParams.GetParam(PRM_PROGRESS_MAX));
  end;
end;

procedure TBaseStatusCommThreadDispatch.DoOnStatus(Sender: TObject; const ID,
  StatusText: String; StatusType: Integer);
begin
  if (not (csDestroying in ComponentState)) and (Assigned(FOnStatus)) then
    FOnStatus(Self, Sender, ID, StatusText, StatusType);
end;

procedure TBaseStatusCommThreadDispatch.DoOnProgress(Sender: TObject;
  const ID: String; Progress, ProgressMax: Integer);
begin
  if not (csDestroying in ComponentState) and (Assigned(FOnProgress)) then
    FOnProgress(Self, Sender, ID, Progress, ProgressMax);
end;

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'); // 12345
MyThreadObject := 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.

Answer 5

What version of Delphi are you using? If you're on D2009 or newer, you can pass an anonymous method to Synchronize that takes no parameters but references local variables, passing them "under the radar" as part of the closure.