Scenario:
User presses Start button random number of times and then has to stop all spawned threads (clicks TerminateButton).
Question:
How to correctly terminate/waitfor/free all executed threads by user?
Normally if I had to run specified number of threads I would just use Array of Threads and then cycle .terminate/.waitfor/free for all items in array.
However in this case I can't do that because number of threads is not determined.
procedure TForm1.StartButtonClick(Sender: TObject);
begin
WorkerThread:=TWorkerThread.Create(true);
WorkerThread.FreeOnTerminate:=false;
WorkerThread.Resume;
end;
procedure TWorkerThread.Execute;
begin
repeat
//some code here
until Terminated=true;
end;
procedure TForm1.TerminateButtonClick(Sender: TObject);
begin
if Assigned(WorkerThread)=true then // <-This will work only for last instance
begin
WorkerThread.terminate; // <-This will work only for last instance
WorkerThread.waitfor; // <-This will work only for last instance
FreeAndNil(WorkerThread); // <-This will work only for last instance
end;
end;
At the moment I'm going to store all threads in TList. This example code seems to work fine.
procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CriticalSection);
ThreadList:=TList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CriticalSection);
end;
procedure TForm1.StartButtonClick(Sender: TObject);
begin
EnterCriticalSection(CriticalSection); //<- This will be required in my real multithreaded code
WorkerThread:=TWorkerThread.Create(true);
ThreadList.Add(WorkerThread);
WorkerThread.FreeOnTerminate:=false;
WorkerThread.OnTerminate:=form1.ThreadTerminated;
WorkerThread.Resume;
LeaveCriticalSection(CriticalSection);
end;
procedure TWorkerThread.Execute;
begin
repeat
sleep(random(1000));
until Terminated=true;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
form1.Memo1.Lines.Add('terminated');
end;
procedure TForm1.TerminateButtonClick(Sender: TObject);
var x:integer;
begin
form1.Memo1.Clear;
EnterCriticalSection(CriticalSection); //<- This will be required in my real multithreaded code
for x:=0 to ThreadList.Count-1 do
begin
if Assigned(ThreadList.Items[x])=true then
begin
WorkerThread:=ThreadList.Items[x];
WorkerThread.Terminate;
WorkerThread.waitfor;
FreeAndNil(WorkerThread);
end;
end;
ThreadList.Clear;
LeaveCriticalSection(CriticalSection);
end;
Related
my code is running a for loop to process some data like here
procedure printValue(Value: Integer);
begin
TThread.Synchronize(TThread.Current, procedure
begin
form1.memo1.lines.add( Value.ToString );
end);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
myThread : TThread;
Proc1: TMyProc;
begin
for I := 0 to 10 do
begin
myThread := TThread.CreateAnonymousThread(
procedure
begin
printValue( i );
end);
myThread.Start;
end;
end;
this code out put is like this:
3
5
6
8
9
11
10
4
11
4
7
this is not good so i add a small delay like sleep(1) after thread start.this will fix output problem but not a good idea because in a large loop block the ui thread so try to use this document as help so my code changed like this:
function CaptureValue(Value: Integer): TMyProc;
begin
Result := procedure begin Writeln(Value); end;
end;
procedure printValue(Value: Integer);
begin
TThread.Synchronize(TThread.Current, procedure
begin
form1.memo1.lines.add( Value.ToString );
end);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
myThread : TThread;
Proc1: TMyProc;
begin
for I := 0 to 10 do
begin
myThread := TThread.CreateAnonymousThread(
procedure
begin
Proc1:= CaptureValue(i);
printValue( Proc1 );
end);
myThread.Start;
end;
end;
but i got [dcc32 Error] Unit11.pas(57): E2010 Incompatible types: 'Integer' and 'procedure, untyped pointer or untyped parameter' error.
what is wrong with my code?
Anonymous procedures capture variables, not values. This is documented behavior. So in both of your examples, your threads are sharing a single I variable with no synchronization over the access of that variable.
You had the right idea to pass I to a procedure and then capture it from the argument list before using it. However, you went about it the wrong way.
The reason your second example actually fails to compile is because you are misusing CaptureValue(). It returns a TMyProc, which is clearly a reference to procedure (which BTW, the RTL already has a TProc for that same purpose). You are passing an anonymous procedure as-is to printValue(), which takes an Integer instead. That is what the compiler error is complaining about.
The way you are using the return value, CaptureValue() would have to instead return an anonymous function that itself returns an Integer (ie, have CaptureValue() return a reference to function: Integer, aka TFunc<Integer>), then call that function and pass that return value to PrintValue().
You are still capturing I itself before passing it to CaptureValue(), though, so you still have threads sharing I. You would need to call CaptureValue() from inside the loop directly before calling CreateAnonymousThread(). But then, your threads would be capturing and sharing the Proc1 variable instead, so you would be right back to the original problem.
With that said, try something more like this instead:
procedure PrintValue(Value: Integer);
begin
TThread.Synchronize(nil,
procedure
begin
Form1.Memo1.Lines.Add( Value.ToString );
end
);
end;
function CaptureAndPrintValue(Value: Integer): TProc;
begin
Result := procedure
begin
printValue( Value );
end
);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to 10 do
begin
TThread.CreateAnonymousThread(
CaptureAndPrintValue(I)
).Start;
end;
end;
Or, you can let the RTL handle the threading for you:
uses
..., System.Threading;
procedure PrintValue(Value: Integer);
begin
// can't use TThread.Synchronize() with TParallel, as it
// doesn't service the main message queue while looping...
TThread.Queue(nil,
procedure
begin
Form1.Memo1.Lines.Add( Value.ToString );
end
);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TParallel.For(0, 10,
procedure(I: Integer)
begin
PrintValue(I);
end
);
end;
Is it possible to start procedure delayed after the calling procedure will end?
procedure StartLoop;
begin
DoSomething;
end;
procedure FormCreate(...);
begin
if ParamStr(1)='start' then StartLoop;
end;
StartLoop will be called inside FormCreate, and FormCreate will be waiting, and block further execution not only the of FormCreate itself, but also further procedures executing after it (FormShow, etc.), and form will not show until StartLoop will end.
I need to wait until FormCreate will end, and run StartLoop after that (without using threads).
If you are using 10.2 Tokyo or later, you can use TThread.ForceQueue():
procedure TMyForm.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
TThread.ForceQueue(nil, StartLoop);
end;
Otherwise, you can use PostMessage() instead:
const
WM_STARTLOOP = WM_USER + 1;
procedure TMyForm.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
PostMessage(Handle, WM_STARTLOOP, 0, 0);
end;
procedure TMyForm.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_STARTLOOP then
StartLoop
else
inherited;
end;
The simplest way is using timer.
Let you create DelayTimer with needed period set and Enabled = False on the form in design time (you can also create it dynamically). Assign event handler for it:
procedure TFormXX.DelayTimerTimer(Sender: TObject);
begin
DelayTimer.Enabled := False; // works only once
StartLoop;
end;
in the form intialization routine start this timer:
procedure FormCreate(...);
begin
if ParamStr(1)='start' then
DelayTimer.Enabled := True;
end;
Perhaps you want to start the timer later, for example - in the OnShow, if your application performs some continuous actions during creation.
AN other solution could be wrapping your DoSomething method into a Task:
uses
System.Threading;
procedure TForm2.DoSomething;
begin
Sleep(2000);
Caption := 'Done';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
TTask.Run(
procedure
begin
DoSomething
end);
end;
I have a simple class that has the following interface implementation.
Note: TPolyBase is an abstract class and TPolyResult is an array of double; it's not important to see their code, it's not relevant here.
//INTERFACE
type
TPolynomialList = class
strict private
FPolynomialList: TObjectList<TPolyBase>;
FResult: TList<TPolyResult>;
FCanGet: boolean;
function GetResult: TList<TPolyResult>;
procedure DoSolve;
public
constructor Create(PolynomialList: TObjectList<TPolyBase>);
destructor Destroy; override;
procedure SolvePolynomials(CompletionHandler: TProc);
property Solutions: TList<TPolyResult> read GetResult;
end;
//IMPLEMENTATION
constructor TPolynomialList.Create(PolynomialList: TObjectList<TPolyBase>);
begin
FPolynomialList := PolynomialList;
FResult := TList<TPolyResult>.Create;
FCanGet := false;
end;
destructor TPolynomialList.Destroy;
begin
FResult.Free;
inherited;
end;
procedure TPolynomialList.DoSolve;
var
i: integer;
begin
for i := 0 to FPolynomialList.Count - 1 do
FResult.Add(FPolynomialList[i].GetSolutions);
FCanGet := true;
end;
function TPolynomialList.GetResult: TList<TPolyResult>;
begin
if FCanGet = false then
raise TEquationError.Create('You must solve the equation first!');
Result := FResult;
end;
procedure TPolynomialList.SolvePolynomials(CompletionHandler: TProc);
begin
TTask.Run(procedure
var
ex: TObject;
begin
try
DoSolve;
TThread.Synchronize(nil, procedure
begin
CompletionHandler;
end);
except
on E: Exception do
begin
ex := AcquireExceptionObject;
TThread.Synchronize(nil, procedure
begin
Writeln( (ex as Exception).Message );
end);
end;
end;
end);
end;
This class takes a list of objects as input and it has an internal important field called FResult that gives the results to the user. It can be accessed from the getter only if the method SolvePolynomials has finished his work.
The problem is in the SolvePolynomials. The code I have shown uses a task because the size of the object list may be very big and I don't want to freeze the UI. Why do I always get an access violation in the task code?
Note that the following code works fine but this is not what I want because if I input 15000 the program freezes for a few seconds.
procedure TPolynomialList.SolvePolynomials(CompletionHandler: TProc);
begin
DoSolve;
CompletionHandler;
end;
Could the FPolynomialList variable be a the problem? If you look at my class the only thing "taken from outside" is the TObjectList<TPolyBase> because in the constructor I simply assing the reference (I'd like to avoid the copy ok 15k items). All the other variables are not shared with anything.
I have seen in many books I have read like "Delphi High Performance" that is good to have a task that calls an inner "slow" method but in this case there could be those reference that are messing up something. Any idea?
This is the code that I am using as test:
var
a: TObjectList<TPolyBase>;
i, j: integer;
f: TPolynomialList;
s: string;
function GetRandom: integer;
begin
Result := (Random(10) + 1);
end;
begin
a := TObjectList<TPolyBase>.Create(true);
try
for i := 0 to 15000 do
begin
a.Add({*Descendant of TPolyBase*})
end;
f := TPolynomialList.Create(a);
try
f.SolvePolynomials(procedure
var
i, j: integer;
begin
for i := 0 to f.Solutions.Count - 1 do
begin
for j := Low(f.Solutions[i]) to High(f.Solutions[i]) do
Writeln({output the results...})
end;
end);
finally
f.Free;
end;
finally
a.Free;
end;
end.
Your SolvePolynomials method delegates solving to another thread and returns before that thread is finished with its task. While that task thread is running it is necessary that all data it operates on is still alive. But, in your code you are releasing necessary object instances right after SolvePolynomials exits - while your task is still running, hence the error.
You have to move releasing of those objects into completion handler.
Basically, your code simplified looks like:
type
TPolynomialList = class
public
destructor Destroy; override;
procedure DoSolve;
procedure SolvePolynomials(CompletionHandler: TProc);
end;
destructor TPolynomialList.Destroy;
begin
Writeln('Destroyed');
inherited;
end;
procedure TPolynomialList.DoSolve;
begin
Writeln('Solving');
end;
procedure TPolynomialList.SolvePolynomials(CompletionHandler: TProc);
begin
TTask.Run(
procedure
begin
try
DoSolve;
TThread.Synchronize(nil,
procedure
begin
CompletionHandler;
end);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end);
end;
procedure Test;
var
f: TPolynomialList;
begin
f := TPolynomialList.Create;
try
f.SolvePolynomials(
procedure
begin
Writeln('Solved');
end);
finally
f.Free;
end;
end;
If you run it output will be:
Destroyed
Solving
Solved
However, if you move releasing of your variables into completion handler order of execution will be correct.
procedure Test;
var
f: TPolynomialList;
begin
f := TPolynomialList.Create;
f.SolvePolynomials(
procedure
begin
Writeln('Solved');
f.Free;
end);
end;
Solving
Solved
Destroyed
For your code, that means moving both a.Free and f.Free into completion handler.
I have an application that restores windows on startup but this results in a potential flicker as each window is created and positioned.
To get around this I have the splash screen (stretched to the full size of the screen) set to "StayOnTop" and close it after the OnShow event using a TTask. The problem is that occasionally the splash screen gets stuck. If you click where buttons should be they redraw and show correctly.
I have tried to "invalidate" all WinControls but this problem still shows up.
I have never seen the problem in the debugger.
Are there any other tricks anyone can suggest to forcing a full repaint of the screen?
Here is my code to close the splash - This is in the OnShow of the main form.
aTask := TTask.Create(procedure()
begin
Sleep(800);
TThread.Synchronize(nil, procedure()
begin
fSplash.Close;
FreeAndNil(fSplash);
DoInvalidate(self);
end);
end);
aTask.Start;
Here is my attempt to invalidate everything...
Procedure DoInvalidate( aWinControl: TWInControl );
var
i: Integer;
ctrl: TControl;
begin
for i:= 0 to aWinControl.Controlcount-1 do
begin
ctrl:= aWinControl.Controls[i];
if ctrl Is TWinControl then
DoInvalidate( TWincontrol( ctrl ));
end;
aWinControl.Invalidate;
end;
Martin
You don't need to recursively invalidate everything, just invalidating the Form itself is sufficient.
If you upgrade to 10.2 Tokyo, you can now use TThread.ForceQueue() instead of TThread.Synchronize() in a TTask:
procedure TMainForm.FormShow(Sender: TObject);
begin
TThread.ForceQueue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end
);
end;
If you stick with TTask, you should at least use TThread.Queue() instead:
procedure TMainForm.FormShow(Sender: TObject);
begin
TTask.Create(procedure
begin
TThread.Queue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end;
end
).Start;
end;
Or, you could just use a short TTimer, like zdzichs suggested:
procedure TMainForm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
FreeAndNil(fSplash);
Invalidate;
end;
Or, you could assign an OnClose event handler to the splash form to invalidate the MainForm, and then PostMessage() a WM_CLOSE message to the splash form:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnClose := SplashClosed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
PostMessage(fSplash.Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.SplashClosed(Sender: TObject; var Action: TCloseAction);
begin
fSplash := nil;
Action := caFree;
Invalidate;
end;
Or, use the OnDestroy event instead:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnDestroy := SplashDestroyed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
fSplash.Release; // <-- delayed free
end;
procedure TMainForm.SplashDestroyed(Sender: TObject);
begin
fSplash := nil;
Invalidate;
end;
I have developed two procedures of two buttons to for task 1 and task 2. Do you know how to create the new button which can repeat the procedures of two previous buttons to perform task 1 + 2 in assigned number of times ?
Extract the tasks into separate methods:
procedure TForm1.DoTask1;
begin
....
end;
procedure TForm1.DoTask2;
begin
....
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DoTask1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DoTask2;
end;
And then add a new button with OnClick handler like this:
procedure TForm1.Button3Click(Sender: TObject);
var
i: Integer;
begin
for i := 1 to N do
begin
DoTask1;
DoTask2;
end;
end;