I need to execute a function in a separated thread and wait until the thread is finished.
For example, here's the original function :
Procedure Search;
begin
CallA;
CallB;
end;
This is the modified function :
Procedure Search;
var
testMyThread: TMyThread;
Done: Boolean;
begin
// create a new thread to execute CallA
testMyThread:=TMyThread.Create(False,Done);
WaitForSingleObject(testMyThread.Handle, INFINITE );
if not Done then
begin
TerminateThread(testMyThread.Handle, 0);
end
else;
CallB;
end
unit uMyThread;
interface
uses classes;
type
TMyThread = class(TThread)
private
{ Private declarations }
FDone: ^boolean;
protected
procedure Execute; override;
public
constructor Create(const aSuspended: boolean; var Done: boolean);
procedure CallA;
end;
implementation
uses uMain;
constructor TMyThread.Create(const aSuspended: boolean;
var Done: boolean);
begin
inherited Create(aSuspended);
FDone := #Done;
end;
procedure TMyThread.CallA;
begin
// enumurating several things + updating the GUI
end;
procedure TMyThread.Execute;
begin
inherited;
Synchronize(CallA); // << the problem
FDone^ := true;
end;
end.
Could you tell me why the thread code above doesn't work (CallA never being executed) if I use Synchronize inside TMyThread.Execute ?
Because Synchronize will call a method within application's message loop. And using WaitForSingleObject you simply put all application on hold. Try this:
Procedure Search;
var
testMyThread: TMyThread;
Done: Boolean;
begin
// create a new thread to execute CallA
testMyThread:=TMyThread.Create(False,Done);
while (not Done) and (not Application.Terminated) do
Application.ProcessMessages;
if not Application.Terminated then
CallB;
end
the Delphi tthread class has an event called onThreadTerminate.
This is called in the context of the application thread, when the thread leaves the execute method.
you can use this event in your application.
Related
I'm using the TThread.DoTerminate method to notify to the main thread which the TThread has terminated. but as soon try to change the properties of some controls (buttons) from inside of the DoTerminate both controls just disappear of the form.
Also when I close the Form I'm getting this message
Project ProjectTest.exe raised exception class EOSError with message
'System Error. Code: 1400. Invalid window handle'.
This is a sample application to reproduce the issue.
type
TFooThread = class;
TFormSample = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FooThread : TFooThread;
procedure ThreadIsDone;
public
end;
TFooThread = class(TThread)
private
FForm : TFormSample;
protected
procedure DoTerminate; override;
public
procedure Execute; override;
constructor Create(AForm : TFormSample); reintroduce;
destructor Destroy; override;
end;
var
FormSample: TFormSample;
implementation
{$R *.dfm}
{ TFooThread }
constructor TFooThread.Create(AForm: TFormSample);
begin
inherited Create(False);
FreeOnTerminate := False;
FForm := AForm;
end;
destructor TFooThread.Destroy;
begin
inherited;
end;
procedure TFooThread.DoTerminate;
begin
FForm.ThreadIsDone;
inherited;
end;
procedure TFooThread.Execute;
var
i : Integer;
begin
for i := 1 to 100 do
begin
Synchronize(
procedure
begin
FForm.ProgressBar1.Position := i;
end
);
Sleep(50);
end;
Terminate();
end;
{ TFormSample }
procedure TFormSample.Button1Click(Sender: TObject);
begin
FooThread := TFooThread.Create(Self);
TButton(Sender).Enabled := false;
end;
procedure TFormSample.FormCreate(Sender: TObject);
begin
FooThread := nil;
Button3.Visible := False;
end;
procedure TFormSample.FormDestroy(Sender: TObject);
begin
if (FooThread<>nil) then
begin
if not FooThread.Terminated then
FooThread.WaitFor;
FooThread.Free;
end;
end;
procedure TFormSample.ThreadIsDone;
begin
//this code is executed but the controls are not updated
//both buttons just disappear from the form !!!!
//Also if I remove these lines, no error is raised.
Button2.Visible := False;
Button3.Visible := True;
end;
end.
The question is : How I can update the properties of some VCL control as soon the TThread is finished?
It should be fine to update controls inside DoTerminate (as you are).
DoTerminate runs in the context of the thread. Therefore it is not safe to update controls from that method. The base implementation synchronises a call to the OnTerminate event.
So OnTerminate is already synchronised. And it will be safe to update controls from an OnTerminate event handler.
However, I would be more inclined to not have code inside the thread class calling the form because this creates a circular dependency. Rather have the form assign a handler for the OnTerminateevent. This way code that controls the form will be in the form class. You can do the same with the control updates to indicate thread progress.
FooThread := TFooThread.Create(...);
//WARNING: If you need to do **any**
//initialisation after creating a
//thread, it's better to create it
//in a Suspended state.
FooThread.OnTerminate := ThreadIsDone;
//Of course you'll have to change the signature of ThreadIsDone accordingly.
FooThread.OnProgress := ThreadProgress;
//You'd have to define a suitable callback event on the thread.
//Finally, if the thread started in a suspended state, resume it.
FooThread.Start;
Avoiding circular dependencies is a little more work, but greatly simplifies an application.
David mentions that you can create your thread in a running state. To do so safely you must:
Pass all necessary initialisation information into the constructor.
And inside the constructor perform all initialisation before calling the inherited constructor.
Also you have a mistake in your Execute method:
procedure TFooThread.Execute;
var
i : Integer;
begin
...
Terminate(); //This is pointless.
//All it does is set Terminated := True;
end;
The thread terminates when it exits. All the call to Terminate does is set an internal flag to indicate the thread should terminate. You'd normally write your Execute method as follows:
begin
while not Terminated do
begin
...
end;
end;
Then your form might have a button which calls: FooThread.Terminate();
This will cause your while loop to exit at the end of the current iteration. This allows the thread to exit "gracefully".
I'm new to multithreading, but not a complete novice. I need to perform a call to a webservice in a worker thread.
In the main thread I have a form (TForm) with a private data member (private string) that only the worker thread will write to (I pass the a pointer to it into the thread before it resumes). When the worker thread has finished its webservice call and written the resultant response xml to the private member on the form, the worker thread uses PostMessage to send a message to the form's handle (which I also passed into the thread before it resumed).
interface
const WM_WEBSERVCALL_COMPLETE = WM_USER + 1;
type
TWebServiceResponseXML = string;
PWebServiceResponseXML = ^TWebServiceResponseXML;
TMyForm = class(TForm)
...
private
...
fWorkerThreadID: Cardinal;
fWebServiceResponseXML: TWebServiceResponseXML;
public
...
procedure StartWorkerThread;
procedure OnWebServiceCallComplete(var Message: TMessage); Message WM_WEBSERVCALL_COMPLETE;
end;
TMyThread = class(TThread)
private
protected
procedure Execute; override;
public
SenderHandle: HWnd;
RequestXML: string;
ResponseXML: string;
IMyService: IService;
PResponseXML: PWebServiceResponseXML;
end;
implementation
procedure TMyForm.StartWorkerThread;
var
MyWorkerThread: TMyThread;
begin
MyWorkerThread := TMyThread.Create(True);
MyWorkerThread.FreeOnTerminate := True;
MyWorkerThread.SenderHandle := self.Handle;
MyWorkerThread.RequestXML := ComposeRequestXML;
MyWorkerThread.PResponseXML := ^fWebServiceResponseXML;
MyWorkerThread.Resume;
end;
procedure TMyForm.OnWebServiceCallComplete(var Message: TMessage);
begin
// Do what you want with the response xml string in fWebServiceResponseXML
end;
procedure TMyThread.Execute;
begin
inherited;
CoInitialize(nil);
try
IMyService := IService.GetMyService(URI);
ResponseXML := IMyService.Search(RequestXML);
PResponseXML := ResponseXML;
PostMessage(SenderHandle, WM_WEBSERVCALL_COMPLETE, 0, 0);
finally
CoUninitialize;
end;
end;
It works great, but now I want to do the same thing from a datamodule (which doesn't have a Handle)... so I would really appreciate some useful code to supplement the working model I have.
EDIT
What I really want is the code (if possible) that would allow me to replace the line
MyWorkerThread.SenderHandle := self.Handle;
with
MyWorkerThread.SenderHandle := GetHandleForThisSOAPDataModule;
I have used this technique before with some success: Sending messages to non-windowed applications
Basically, use a second thread as a message pump on a handle obtained via AllocateHWND. This is admittedly irritating, and you would be better off using a library to handle all the details. I prefer OmniThreadLibrary but there are others - see How Do I Choose Between the Various Ways to do Threading in Delphi? and Delphi - Threading frameworks.
You can allocate you own handle with AllocateHwnd and use that as a PostMessage target.
TTestThread = class(TThread)
private
FSignalShutdown: boolean;
// hidden window handle
FWinHandle: HWND;
protected
procedure Execute; override;
// our window procedure
procedure WndProc(var msg: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure PrintMsg;
end;
constructor TTestThread.Create;
begin
FSignalShutdown := False;
// create the hidden window, store it's
// handle and change the default window
// procedure provided by Windows with our
// window procedure
FWinHandle := AllocateHWND(WndProc);
inherited Create(False);
end;
destructor TTestThread.Destroy;
begin
// destroy the hidden window and free up memory
DeallocateHWnd(FWinHandle);
inherited;
end;
procedure TTestThread.WndProc(var msg: TMessage);
begin
if Msg.Msg = WM_SHUTDOWN_THREADS then
// if the message id is WM_SHUTDOWN_THREADS
// do our own processing
FSignalShutdown := True
else
// for all other messages call
// the default window procedure
Msg.Result := DefWindowProc(FWinHandle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;
You can apply this to anything not just threads. Just beware that AllocateHWND is NOT threade safe as indicated here.
Alternatives based on the use of an event:
Use OnTerminate of the thread (already present) in combination with a flag:
TMyDataModule = class(TDataModule)
private
procedure OnWebServiceCallComplete(Sender: TObject);
...
TMyThread = class(TThread)
public
property TerminateFlag: Integer ...
...
procedure TMyDataModule.StartWorkerThread;
...
MyWorkerThread.OnTerminate := <Self.>OnWebServiceCallComplete;
...
procedure TMyDataModule.OnWebServiceCallComplete(Sender: TObject);
begin
if MyWorkerThread.TerminateFlag = WEBCALL_COMPLETE then
...
end;
Set the TerminateFlag in the Execute routine. OnTerminate will automatically fire, even if FreeOnTerminate is True.
Add a new event property to the thread class in which you may provide the flag as a parameter to indicate termination/thread result. Something like shown here. Be sure to synchronize the event call. Or forget the parameter and just only call the event if execution completed gracefully (like you're doing now).
i use this component for processing drag and drop files
http://melander.dk/delphi/dragdrop
unit DragThread;
interface
uses
Classes,DragDrop, DropTarget,DragDropFile,Dialogs,SysUtils;
type
TDragThread = class(TThread)
private
{ Private declarations }
ArraysLength : Integer;
DragComponent : TDropFileTarget;
DragArray,HashsArray : Array of string;
Procedure FDArray;
//Procedure FDHArray;
protected
procedure Execute; override;
Public
Constructor Create(Com: TDropFileTarget);
Destructor Destroy; Override;
end;
implementation
{ TDragThread }
Constructor TDragThread.Create(Com: TDropFileTarget);
begin
inherited Create(True);
DragComponent := Com;
end;
Destructor TDragThread.Destroy;
begin
//DragComponent.Free;
end;
Procedure TDragThread.FDArray;
var
A : Integer;
begin
SetLength(DragArray,DragComponent.Files.Count);
SetLength(HashsArray,DragComponent.Files.Count);
ShowMessage(IntToStr(DragComponent.Files.Count)); // just working in the first time !!
for A := 0 to DragComponent.Files.Count -1 do begin
DragArray[A] := DragComponent.Files[A];
//ShowMessage(DragComponent.Files[A]);
end;
ArraysLength := DragComponent.Files.Count-1;
//ShowMessage(DragComponent.Files[0]);
end;
procedure TDragThread.Execute;
begin
{ Place thread code here }
FDArray;
end;
end.
the strange thing that the Drop process working just one time then the DragComponent.Files.Count gives 0 for ever .!!
that's how i call it
procedure TForm1.DropFileDrop(Sender: TObject; ShiftState: TShiftState;
APoint: TPoint; var Effect: Integer);
var
DropThread : TDragThread;
begin
DropThread := TDragThread.Create(DropFile);
DropThread.Resume;
end;
i want to know why this happened and thanks in advance :) .
Don't operate VCL components from other threads.
There's no guarantee that the component's drop-event information will continue to be valid once the drop event has completed.
Copy all the information you need out of the component when you construct the thread (i.e., fully populate DragArray) and then use that cached data when executing the thread. Don't store a reference in DragComponent or you might be tempted to use it from the thread's Execute method, which you really shouldn't do.
I make a logging application and I have a LogEvent object with some string properties on it. I want to make this logging asynchronous and in another thread for not blocking the applications GUI thread.
Idea is that when I start application, some LogEventThread is running on the background all the time. If LogEvent property has changed then thread is executed, after execution thread suspends and waits another LogEvent object property change and run it again if new property change is captured.
Which are the best practises to design this?
EDIT:
I created an example. Please tell me if I'm on the correct path.
I have a Form1:
unit MainWindow;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TrackEventSenderThread, Generics.Collections, TrackEvent;
type
TForm1 = class(TForm)
btnTest: TButton;
procedure FormCreate(Sender: TObject);
procedure btnTestClick(Sender: TObject);
private
teqTrackEventSenderThread: TTrackEventSenderThread;
trackEventQueue: TThreadedQueue<TTrackEvent>;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnTestClick(Sender: TObject);
var
trackEvent: TTrackEvent;
begin
trackEvent := TTrackEvent.Create;
trackEvent.Category := 'test';
trackEvent.Action := 'test';
trackEventQueue.PushItem(trackEvent);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
trackEventQueue := TThreadedQueue<TTrackEvent>.Create;
teqTrackEventSenderThread := TTrackEventSenderThread.Create(True);
teqTrackEventSenderThread.TrackEventQueue := trackEventQueue;
teqTrackEventSenderThread.Start;
end;
end.
TrackEvent class:
unit TrackEvent;
interface
type
TTrackEvent = class(TObject)
private
sCategory: string;
sAction: string;
public
property Category: string read sCategory write sCategory;
property Action: string read sAction write sAction;
end;
implementation
end.
And thread class:
unit TrackEventSenderThread;
interface
uses Classes, Generics.Collections, TrackEvent;
type
TTrackEventSenderThread = class(TThread)
private
trackEvent: TTrackEvent;
teqTrackEventQueue: TThreadedQueue<TTrackEvent>;
public
constructor Create(CreateSuspended: Boolean);
property TrackEventQueue: TThreadedQueue<TTrackEvent> read teqTrackEventQueue write teqTrackEventQueue;
protected
procedure Execute; override;
end;
implementation
constructor TTrackEventSenderThread.Create(CreateSuspended: Boolean);
begin
inherited;
end;
procedure TTrackEventSenderThread.Execute;
begin
while not Terminated do
begin
if teqTrackEventQueue.QueueSize > 0 then
begin
trackEvent := teqTrackEventQueue.PopItem;
//send data to server
end;
end;
end;
end.
You can build a thread-safe Queue class which is used in a Producer-Consumer model. Your TThread descendant class should own an instance of this Queue class.
When you start your application, your queue is empty, and your logging thread is blocked waiting for queue. When you push a new string into the queue from the main thread, your queue pulses the logging thread, your logging thread wakes up and pops items from the queue until the queue is empty again.
To implement the queue in Delphi 2010, you can use TQueue generic class as the base type, and use System.TMonitor for synchronization. In Delphi XE, there is already a class which implements this for you, named TThreadedQueue. So If you are using Delphi XE, create an instance of TThreadedQueue, and in your logging thread try to call its PopItem() method.
EDIT:
Here is a sample logging thread which receives string logs:
unit uLoggingThread;
interface
uses
SysUtils, Classes, Generics.Collections, SyncObjs {$IFDEF MSWINDOWS} , Windows {$ENDIF};
type
TLoggingThread = class(TThread)
private
FFileName : string;
FLogQueue : TThreadedQueue<string>;
protected
procedure Execute; override;
public
constructor Create(const FileName: string);
destructor Destroy; override;
property LogQueue: TThreadedQueue<string> read FLogQueue;
end;
implementation
{ TLoggingThread }
constructor TLoggingThread.Create(const FileName: string);
begin
inherited Create(False);
FFileName := FileName;
FLogQueue := TThreadedQueue<string>.Create;
end;
destructor TLoggingThread.Destroy;
begin
FLogQueue.Free;
inherited;
end;
procedure TLoggingThread.Execute;
var
LogFile : TFileStream;
FileMode : Word;
ALog : string;
begin
NameThreadForDebugging('Logging Thread');
// FreeOnTerminate := True;
if FileExists(FFileName) then
FileMode := fmOpenWrite or fmShareDenyWrite
else
FileMode := fmCreate or fmShareDenyWrite;
LogFile := TFileStream.Create(FFileName,FileMode);
try
while not Terminated do
begin
ALog := FLogQueue.PopItem;
if (ALog <> '') then
LogFile.Write(ALog[1],Length(ALog)*SizeOf(Char));
end;
finally
LogFile.Free;
end;
end;
end.
This TThread descendant uses a TThreadedQueue object as a buffer. When FLogQueue.PopItem is called, if the queue is empty, the thread goes to sleep, and waits until something is pushed into the queue. When an item is available in the queue, the thread pops it, and writes it to a file. This is a very simple code to just let you understand the basics of what you should do.
And here is a sample code for a form which is running in the context of main thread, and is logging a sample message:
unit fMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uLogginThread;
type
TfrmMain = class(TForm)
btnAddLog: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnAddLogClick(Sender: TObject);
private
FLoggingThread : TLoggingThread;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FLoggingThread := TLoggingThread.Create(ExtractFilePath(Application.ExeName) + 'Logs.txt');
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FLoggingThread.Terminate;
FLoggingThread.LogQueue.DoShutDown;
FLoggingThread.WaitFor;
FreeAndNil(FLoggingThread);
end;
procedure TfrmMain.btnAddLogClick(Sender: TObject);
begin
FLoggingThread.LogQueue.PushItem('This is a test log. ');
end;
end.
Here an instance of TLoggingThread is created when the form is initialized. When you press btnAddLog, a sample message is sent to the logger thread via its LogQueue property.
Take note of how the thread is terminated in FormDestroy method. First the thread is signaled that it is terminated, then we tell LogQueue to release any lock, so if the logger thread is waiting for the queue, it will wake up automatically after calling DoShutDown. Then we wait for the thread to finish up by calling WaitFor method, and eventually we destroy the thread instance.
Good Luck
In a multi-threaded application, use
TEvent to allow one thread to signal
to other threads that an event has
occurred.
http://docwiki.embarcadero.com/VCL/en/SyncObjs.TEvent
I would use a Queue of strings with a critical section inside push() and pop(). Inside the thread I would pop strings off, and log them. Inside the GUI thread I would push strings on the queue. I have done something similar before, and it is simple to implement.
Edit
Interface:
TThreadSafeQueue = class(TQueue)
protected
procedure PushItem(AItem: Pointer); override;
function PopItem: Pointer; override;
function PeekItem: Pointer; override;
end;
var
CRITICAL_SECTION: TCriticalSection;
Implementation:
function TThreadSafeQueue.PeekItem: Pointer;
begin
CRITICAL_SECTION.Enter;
Result := inherited PeekItem;
CRITICAL_SECTION.Leave;
end;
function TThreadSafeQueue.PopItem: Pointer;
begin
CRITICAL_SECTION.Enter;
Result := inherited PopItem;
CRITICAL_SECTION.Leave;
end;
procedure TThreadSafeQueue.PushItem(AItem: Pointer);
begin
CRITICAL_SECTION.Enter;
inherited PushItem(AItem);
CRITICAL_SECTION.Leave;
end;
Initialization
CRITICAL_SECTION := TCriticalSection.Create;
Finalization
FreeAndNil(CRITICAL_SECTION);
This code uses pointers to objects, but you can create storage for your strings inside the object, using a stringlist or array or whatever best fits your purpose, and change the pop and push methods to operate on your own storage.
Edit
Something like this:
procedure TMyThread.Execute;
var
Msg: string;
begin
while not Terminated do
begin
if FQueue.Count > 0 then
begin
Msg := FQueue.pop();
PerformLog(Msg); {Whatever your logging method is}
end;
Sleep(0);
end;
end;
TThread's resume method is deprecated in D2010. So, I thought it should now work like this:
TMyThread = class (TThread)
protected
Execute; override;
public
constructor Create;
end;
...
TMyThread.Create;
begin
inherited Create (True);
...
Start;
end;
Unfortunately I get an exception "Cannot call start on a running or supsended thread"...which seems weird to me considering the fact that the documentation tells me that I should call Start on a thread created in suspended mode.
What am I missing here?
The reason is that a Thread is not supposed to start itself.
The thread never knows when initialization is complete. Construction is not the same as initialization (construction should always be short and exception free; further initialization is done after construction).
A similar situation is a TDataSet: no TDataSet constructor should ever call Open, or set Active := True.
See also this blog entry by Wings of Wind.
You should either:
Create the TMyThread suspended by calling Create(true) and perform the Start outside your TMyThread class
Create the TMyThread non-suspeneded, making sure the Create constructor does full initialization, and let TThread.AfterConstruction start the thread.
Explanation of TThread usage:
Basically, a thread should be just that: the encapsulation of the context on which code is executed.
The actual code (the business logic) that is executed should then be in other classes.
By decoupling those two, you gain a lot of flexibility, especially initiating your business logic from within multiple places (which is very convenient when writing unit tests!).
This is the kind of framework you could use for that:
unit DecoupledThreadUnit;
interface
uses
Classes;
type
TDecoupledThread = class(TThread)
strict protected
//1 called in the context of the thread
procedure DoExecute; virtual;
//1 Called in the context of the creating thread (before context of the new thread actualy lives)
procedure DoSetUp; virtual;
//1 called in the context of the thread right after OnTerminate, but before the thread actually dies
procedure DoTearDown; virtual;
protected
procedure DoTerminate; override;
procedure Execute; override;
public
constructor Create;
procedure AfterConstruction; override;
end;
implementation
constructor TDecoupledThread.Create;
begin
// create suspended, so that AfterConstruction can call DoSetup();
inherited Create(True);
end;
procedure TDecoupledThread.AfterConstruction;
begin
// DoSetUp() needs to be called without the new thread in suspended state
DoSetUp();
// this will unsuspend the underlying thread
inherited AfterConstruction;
end;
procedure TDecoupledThread.DoExecute;
begin
end;
procedure TDecoupledThread.DoSetUp;
begin
end;
procedure TDecoupledThread.DoTearDown;
begin
end;
procedure TDecoupledThread.DoTerminate;
begin
inherited DoTerminate();
// call DoTearDown on in the thread context right before it dies:
DoTearDown();
end;
procedure TDecoupledThread.Execute;
begin
// call DoExecute on in the thread context
DoExecute();
end;
end.
You could even make it event based by something like this:
unit EventedThreadUnit;
interface
uses
Classes,
DecoupledThreadUnit;
type
TCustomEventedThread = class(TDecoupledThread)
private
FOnExecute: TNotifyEvent;
FOnSetUp: TNotifyEvent;
FOnTearDown: TNotifyEvent;
strict protected
procedure DoExecute; override;
procedure DoSetUp; override;
procedure DoTearDown; override;
public
property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
property OnSetUp: TNotifyEvent read FOnSetUp write FOnSetUp;
property OnTearDown: TNotifyEvent read FOnTearDown write FOnTearDown;
end;
// in case you want to use RTTI
TEventedThread = class(TCustomEventedThread)
published
property OnExecute;
property OnSetUp;
property OnTearDown;
end;
implementation
{ TCustomEventedThread }
procedure TCustomEventedThread.DoExecute;
var
TheOnExecute: TNotifyEvent;
begin
inherited;
TheOnExecute := OnExecute;
if Assigned(TheOnExecute) then
TheOnExecute(Self);
end;
procedure TCustomEventedThread.DoSetUp;
var
TheOnSetUp: TNotifyEvent;
begin
inherited;
TheOnSetUp := OnSetUp;
if Assigned(TheOnSetUp) then
TheOnSetUp(Self);
end;
procedure TCustomEventedThread.DoTearDown;
var
TheOnTearDown: TNotifyEvent;
begin
inherited;
TheOnTearDown := OnTearDown;
if Assigned(TheOnTearDown) then
TheOnTearDown(Self);
end;
end.
Or adapt it for DUnit TTestCase descendants like this:
unit TestCaseThreadUnit;
interface
uses
DecoupledThreadUnit,
TestFramework;
type
TTestCaseRanEvent = procedure (Sender: TObject; const TestResult: TTestResult) of object;
TTestCaseThread = class(TDecoupledThread)
strict private
FTestCase: TTestCase;
strict protected
procedure DoTestCaseRan(const TestResult: TTestResult); virtual;
function GetTestCase: TTestCase; virtual;
procedure SetTestCase(const Value: TTestCase); virtual;
protected
procedure DoExecute; override;
procedure DoSetUp; override;
procedure DoTearDown; override;
public
constructor Create(const TestCase: TTestCase);
property TestCase: TTestCase read GetTestCase write SetTestCase;
end;
implementation
constructor TTestCaseThread.Create(const TestCase: TTestCase);
begin
inherited Create();
Self.TestCase := TestCase;
end;
procedure TTestCaseThread.DoExecute;
var
TestResult: TTestResult;
begin
if Assigned(TestCase) then
begin
// this will call SetUp and TearDown on the TestCase
TestResult := TestCase.Run();
try
DoTestCaseRan(TestResult);
finally
TestResult.Free;
end;
end
else
inherited DoExecute();
end;
procedure TTestCaseThread.DoTestCaseRan(const TestResult: TTestResult);
begin
end;
function TTestCaseThread.GetTestCase: TTestCase;
begin
Result := FTestCase;
end;
procedure TTestCaseThread.SetTestCase(const Value: TTestCase);
begin
FTestCase := Value;
end;
procedure TTestCaseThread.DoSetUp;
begin
if not Assigned(TestCase) then
inherited DoSetUp();
end;
procedure TTestCaseThread.DoTearDown;
begin
if not Assigned(TestCase) then
inherited DoTearDown();
end;
end.
--jeroen
Short answer: call inherited Create(false) and omitt the Start!
The actual Start of a non-create-suspended thread is done in AfterConstruction, which is called after all constructors have been called.