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 th
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.
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.
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.
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;
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.