I do not know how to Create a TTask where I have a Procedure with parameters, without parameters it works but with parameters it does not .
Example
procedure TMain.SYNC(AProgressBar: TProgressBar; ASleep: Integer);
var i : integer;
begin
for i := 0 to 100 do
begin
sleep(ASleep);
TThread.Queue(TThread.CurrentThread,
procedure
begin
AProgressBar.Position:=i;
end);
end;
end;
Then I would like to create 4 Tasks like this :
setlength(Tasks,4);
Tasks[0] := TTask.Create(SYNC(progressThread1,100));
Tasks[1] := TTask.Create(SYNC(progressThread2,150));
Tasks[2] := TTask.Create(SYNC(progressThread3,300));
Tasks[3] := TTask.Create(SYNC(progressThread4,200));
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
TTask operates with anonymous procedures. You can capture the values that you want to pass to your method, eg:
SetLength(Tasks, 4);
Tasks[0] := TTask.Create(
procedure
begin
SYNC(progressThread1, 100);
end
);
Tasks[1] := TTask.Create(
procedure
begin
SYNC(progressThread2, 150);
end
);
Tasks[2] := TTask.Create(
procedure
begin
SYNC(progressThread3, 300);
end
);
Tasks[3] := TTask.Create(
procedure
begin
SYNC(progressThread4, 200);
end
);
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
Extending the Remy's answer, you can also write a function which returns an anonymous function that you pass to the task.
function MakeSync(AProgressBar: TProgressBar; ASleep: integer): TProc;
begin
Result :=
procedure
begin
SYNC(AProgressBar, ASleep);
end;
end;
SetLength(Tasks, 4);
Tasks[0] := TTask.Create(MakeSYNC(progressThread1, 100));
Tasks[1] := TTask.Create(MakeSYNC(progressThread2, 150));
Tasks[2] := TTask.Create(MakeSYNC(progressThread3, 300));
Tasks[3] := TTask.Create(MakeSYNC(progressThread4, 200));
Tasks[0].Start;
Tasks[1].Start;
Tasks[2].Start;
Tasks[3].Start;
Extending Remy's answer.
The loop 0..100 calling TThread.Queue with index i suffers from updating the progressbar with the i reference value, rather than the passed value.
To better view the consequence of this, remove the sleep call and add the i value to a memo. This will reveal a sequence similar to this:
42
101
101
101
...
101
Here is an example of how to capture the value of i when calling TThread.Queue:
procedure TMain.SYNC(AProgressBar: TProgressBar; ASleep: Integer);
function CaptureValue( ix : Integer) : TThreadProcedure;
begin
Result :=
procedure
begin
AProgressBar.Position := ix;
end;
end;
var i : integer;
begin
for i := 0 to 100 do
begin
sleep(ASleep);
TThread.Queue(TThread.CurrentThread, CaptureValue(i) );
end;
end;
Related
I have found this Remy's interesting code.
Delphi : How to create and use Thread locally?
Can this be done so I can do multiple threads and wait until they are all finished and then continue with main thread? I tried it like this but no success...
procedure Requery(DataList: TStringList);
var
Event: TEvent;
H: THandle;
OpResult: array of Boolean;
i: Integer;
begin
Event := TEvent.Create;
try
SetLength(OpResult, DataList.Count);
for i:=0 to DataList.Count-1 do begin
TThread.CreateAnonymousThread(
procedure
begin
try
// run query in thread
OpResult[i]:=IsMyValueOK(DataList.Strings[i]);
finally
Event.SetEvent;
end;
end
).Start;
H := Event.Handle;
end;
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0+1) do Application.ProcessMessages;
for i:=Low(OpResult) to High(OpResult) do begin
Memo1.Lines.Add('Value is: ' + BoolToStr(OpResult[i], True));
end;
finally
Event.Free;
end;
// Do next jobs with query
...
end;
Can this be done so I can do multiple threads and wait until they are all finished
Yes. You simply need to create multiple TEvent objects, one for each TThread, and then store all of their Handles in an array to pass to MsgWaitForMultipleObjects():
procedure Requery(DataList: TStringList);
var
Events: array of TEvent;
H: array of THandle;
OpResult: array of Boolean;
i: Integer;
Ret, Count: DWORD;
// moved into a helper function so that the anonymous procedure
// can capture the correct Index...
procedure StartThread(Index: integer);
begin
Events[Index] := TEvent.Create;
TThread.CreateAnonymousThread(
procedure
begin
try
// run query in thread
OpResult[Index] := IsMyValueOK(DataList.Strings[Index]);
finally
Events[Index].SetEvent;
end;
end
).Start;
H[Index] := Events[Index].Handle;
end;
begin
if DataList.Count > 0 then
begin
SetLength(Events, DataList.Count);
SetLength(H, DataList.Count);
SetLength(OpResult, DataList.Count);
try
for i := 0 to DataList.Count-1 do begin
StartThread(i);
end;
Count := Length(H);
repeat
Ret := MsgWaitForMultipleObjects(Count, H[0], False, INFINITE, QS_ALLINPUT);
if Ret = WAIT_FAILED then RaiseLastOSError;
if Ret = (WAIT_OBJECT_0+Count) then
begin
Application.ProcessMessages;
Continue;
end;
for i := Integer(Ret-WAIT_OBJECT_0)+1 to High(H) do begin
H[i-1] := H[i];
end;
Dec(Count);
until Count = 0;
for i := Low(OpResult) to High(OpResult) do begin
Memo1.Lines.Add('Value is: ' + BoolToStr(OpResult[i], True));
end;
finally
for i := Low(Events) to High(Events) do begin
Events[i].Free;
end;
end;
end;
// Do next jobs with query
...
end;
That being said, you could alternatively get rid of the TEvent objects and wait on the TThread.Handles instead. A thread's Handle is signaled for a wait operation when the thread is fully terminated. The only gotcha is that TThread.CreateAnonymousThread() creates a TThread whose FreeOnTerminate property is True, so you will have to turn that off manually:
procedure Requery(DataList: TStringList);
var
Threads: array of TThread;
H: array of THandle;
OpResult: array of Boolean;
i: Integer;
Ret, Count: DWORD;
// moved into a helper function so that the anonymous procedure
// can capture the correct Index...
procedure StartThread(Index: integer);
begin
Threads[Index] := TThread.CreateAnonymousThread(
procedure
begin
// run query in thread
OpResult[Index] := IsMyValueOK(DataList.Strings[Index]);
end
);
Threads[Index].FreeOnTerminate := False;
H[Index] := Threads[Index].Handle;
Threads[Index].Start;
end;
begin
try
SetLength(Threads, DataList.Count);
SetLength(H, DataList.Count);
SetLength(OpResult, DataList.Count);
for i := 0 to DataList.Count-1 do begin
StartThread(i);
end;
Count := Length(H);
repeat
Ret := MsgWaitForMultipleObjects(Count, H[0], False, INFINITE, QS_ALLINPUT);
if Ret = WAIT_FAILED then RaiseLastOSError;
if Ret = (WAIT_OBJECT_0+Count) then
begin
Application.ProcessMessages;
Continue;
end;
for i := Integer(Ret-WAIT_OBJECT_0)+1 to High(H) do begin
H[i-1] := H[i];
end;
Dec(Count);
until Count = 0;
for i := Low(OpResult) to High(OpResult) do begin
Memo1.Lines.Add('Value is: ' + BoolToStr(OpResult[i], True));
end;
finally
for i := Low(Threads) to High(Threads) do begin
Threads[i].Free;
end;
end;
// Do next jobs with query
...
end;
Either way, note that MsgWaitForMultipleObjects() is limited to waiting on a maximum of 63 (MAXIMUM_WAIT_OBJECTS[64] - 1) handles at a time. The WaitForMultipleObjects() documentation explains how to work around that limitation, if you need to:
To wait on more than MAXIMUM_WAIT_OBJECTS handles, use one of the following methods:
Create a thread to wait on MAXIMUM_WAIT_OBJECTS handles, then wait on that thread plus the other handles. Use this technique to break the handles into groups of MAXIMUM_WAIT_OBJECTS.
Call RegisterWaitForSingleObject to wait on each handle. A wait thread from the thread pool waits on MAXIMUM_WAIT_OBJECTS registered objects and assigns a worker thread after the object is signaled or the time-out interval expires.
Or, you could simply process your list in smaller batches, say no more than 50-60 items at a time.
I need to run multiples blocks of threads at same time. What Im trying to do is:
A have 197 operation do call individualy on shellExecute
I want to run 4 operations simultanelly
I can only start new operation if I have less then 4 executing
Problems:
I have to insert a lot of Application.ProcessMessages to make it work, and I dont know what Im doing wrong. I tryed everything and nothing seems to work.
Here is the code:
procedure TCompress.NewThread(psArgs: PWideChar);
var
oThread: TThread;
nCode : DWord;
begin
oThread := TThread.CreateAnonymousThread(
procedure
begin
try
FNumberOfThreads := FNumberOfThreads +1;
ExecuteAndWait(PChar(FsPathCompressor), psArgs, SW_HIDE, nCode);
//It is just a CreateProcess with WaitForSingleObject(retorno, INFINITE);
except on E: Exception do
begin
raise;
end;
end;
end);
oThread.OnTerminate := DoOnTerminate;
oThread.Start;
end;
procedure TspCompress.DoOnTerminate;
begin
FNumberOfThreads := FNumberOfThreads -1;
end;
function TspCompress.ExecuteBlocks: Boolean;
var
sArgs : WideString;
nBlocksCreated, nTotalBlocks: Integer;
begin
nTotalBlocks := 197;
nBlocksCreated := 0;
while nBlocksCreated < nTotalBlocks do
begin
//Needs Application.ProcessMessages to update FNumberOfThreads.
while (FNumberOfThreads < 4) and (nBlocksCreated < nTotalBlocks) do
begin
try
sArgs := PChar('C:/file.exe');
NewThread(PWideChar(sArgs));
//Needs Application.ProcessMessages to start the thread.
nBlocksCreated := nBlocksCreated + 1;
except
on E: Exception do
begin
//Do Something
end;
end;
end;
end;
end;
FNumberOfThreads is a private variable of the class
This is a sample code of what Im doing. The problem is not with the code it self, but with the Thread concept.
At the end, I just used System.Threading. Setting a ThreadPool and using Parellel.For.
procedure TCompress.MyParallelProcess;
var
sArgs : WideString;
nTotalProcess: Integer;
oPool: TThreadPool;
nCode: DWord;
begin
oPool := TThreadPool.Create;
try
oPool.SetMinWorkerThreads(4);
oPool.SetMaxWorkerThreads(4);
nTotalProcess := 197;
TParallel.For(1, nTotalProcess, procedure(i: integer)
begin
sArgs := PChar('C:/file'+IntToStr(i)+'.exe');
ExecuteAndWait(PChar(FsPathCompressor), sArgs, SW_HIDE, nCode);
end, oPool);
finally
FreeAndNil(oPool);
end;
end;
Remember, this is just a sample code, but i did something like this and works as a glove.
Thanks all for your help.
I use Delphi 7. I create a record that stores info, and using pointers I store that record as an object in a TreeView with more than 100 items.
My problem is, how to release or eliminate all these objects from memory?
type
PMyRec = ^TMyRec;
TMyRec = record
Tipo: string;
parent: string;
end;
var
MyRecPtr: PMyRec;
for x := 1 to 100 do
begin
New(MyRecPtr);
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
ListaDePonteiros.Add( MyRecPtr ); // I use a TList to store pointers
ListaDeObjectos.Add( MyRecPtr ); // I use a TList to store Objects
end;
How I try to delete them all:
procedure TForm1.Button2Click(Sender: TObject);
procedure EmptyTList(Var AList: TList);
var
intContador: integer;
begin
for intContador := (AList.Count-1) downto 0 do
begin
if Assigned(AList.Items[intContador]) then
begin
Dispose(AList.Items[intContador]);
AList.Items[intContador] := nil;
AList.Delete(intContador);
end;
end;
end;
begin
if Assigned(MyRecPtr) then
begin
EmptyTList(ListaDePonteiros);
end;
end;
When I delete all items in the TreeView OnDelete event, I have this:
if assigned(Node.Data) then
begin
Dispose(Node.Data);
end;
What I want to do is release all objects from memory!
If I dispose all objects using that list then if I delete any item from the TreeView an invalid pointer error is raised!!
Even with all pointers disposed, MyRecPtr still points to somewhere in memory, and Node.Data too!
Your code is crashing because you are freeing the same memory twice, because you have not defined any clear ownership of your record instances.
Your ListaDePonteiros and ListaDeObjectos lists are redundant and can be removed. The TTreeView can be the owner of the records and you can simply Dispose() of them in the TTreeView.OnDeletion event and be done with it 1.
var
MyRecPtr: PMyRec;
for x := 1 to 100 do
begin
New(MyRecPtr);
try
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
except
Dispose(MyRecPtr);
raise;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Tree1.Items.Clear;
end;
procedure TForm1.Tree1Deletion(Sender: TObject; Node: TTreeNode);
begin
if Assigned(Node.Data) then
Dispose(PMyRec(Node.Data));
end;
Otherwise, if you choose to keep a separate list, keep the ListaDeObjectos list and remove the ListaDePonteiros list (as there is no reason to maintain 2 lists tracking the exact same values). You would just need to decide whether you want ListaDeObjectos or Tree1 to own the records you allocate:
If ListaDeObjectos is to be the owner, DO NOT call Dispose(Node.Data) in the TTreeView.OnDeletion event.
var
MyRecPtr: PMyRec;
Idx: Integer;
for x := 1 to 100 do
begin
New(MyRecPtr);
try
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Idx := ListaDeObjectos.Add(MyRecPtr);
try
Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
except
ListaDeObjectos.Delete(Idx);
raise;
end;
except
Dispose(MyRecPtr);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
procedure EmptyTList(AList: TList);
var
intContador: integer;
begin
for intContador := 0 to (AList.Count-1) do
Dispose(PMyRec(AList[intContador]));
AList.Clear;
end;
begin
Tree1.Items.Clear;
EmptyTList(ListaDePonteiros);
end;
If Tree1 is to be the owner, DO NOT call Dispose(AList.Items[intContador]) in EmptyTList() (in fact, you can get rid of EmptyTList() altogether and just call ListaDeObjectos.Clear() when needed).
var
MyRecPtr: PMyRec;
Node: TNode;
for x := 1 to 100 do
begin
New(MyRecPtr);
try
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Node := Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
except
Dispose(MyRecPtr);
raise;
end;
try
ListaDePonteiros.Add(MyRecPtr);
except
Node.Free;
raise;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ListaDePonteiros.Clear;
Tree1.Items.Clear;
end;
procedure TForm1.Tree1Deletion(Sender: TObject; Node: TNode);
begin
if Assigned(Node.Data) then
Dispose(PMyRec(Node.Data));
end;
Either way, when not mass-clearing Tree1 and ListaDeObjectos in one go, consider calling ListaDeObjectos.Remove() in the TTreeView.OnDeletion event to keep Tree1 and ListaDeObjectos in sync when removing individual nodes:
procedure TForm1.Tree1Deletion(Sender: TObject; Node: TNode);
begin
if Assigned(Node.Data) then
begin
// only if the TreeView is the owner...
Dispose(PMyRec(Node.Data));
ListaDeObjectos.Remove(Node.Data);
end;
end;
1. Whenever you do Dispose() your record instance, make sure you type-cast raw pointers to PMyRec or else the compiler will not finalize the record's members correctly, leaking memory.
In a System.Threading.TParallel.For loop, I need to write-access a string variable which is declared outside of the TParallel.For loop threads:
// Main thread:
procedure TForm2.GetWeather;
var
CurrentWeather: string;
begin
CurrentWeather := 'Current weather: ';
System.Threading.TParallel.For(1, 10,
procedure(idx: Integer)
begin
if IsRainy(idx) then
begin
// loop thread needs to write-access a mainthread-string-variable:
CurrentWeather := CurrentWeather + 'bad weather, ';
end;
end);
Self.Caption := CurrentWeather;
end;
But according to the documentation, this should not be done. And System.SyncObjs.TInterlocked doesn't seem to have a method to write to a string variable.
So how can I write to the CurrentWeather variable in this case?
Delphi 10.1.2 Berlin
EDIT:
Following the advice of David Heffernan I rewrote the code - is this correct?:
// Main thread:
procedure TForm2.GetWeather;
var
CurrentWeather: string;
ALock: TCriticalSection;
begin
CurrentWeather := 'Current weather: ';
ALock := TCriticalSection.Create;
try
System.Threading.TParallel.For(1, 10,
procedure(idx: Integer)
begin
if IsRainy(idx) then
begin
ALock.Enter;
try
CurrentWeather := CurrentWeather + 'bad weather, ';
finally
ALock.Leave;
end;
end;
end);
finally
ALock.Free;
end;
Self.Caption := CurrentWeather;
end;
You need to use a lock to modify complex data types like string. This cannot be done atomically.
Use TCriticalSection if you target just Windows. For code that targets other platforms then you should use TMonitor.
Another option is to use TThread.Queue, for example like this (this assumes that you want to update caption dynamically, rather than accumulate result and show it after all threads are finished)
procedure TForm1.Button6Click(Sender: TObject);
begin
Caption := 'Current weather: ';
TParallel.For(1, 10,
procedure(idx: Integer)
begin
if IsRainy(idx) then
begin
// loop thread needs to write-access a mainthread-string-variable:
TThread.Queue(TThread.Current,
procedure
begin
Caption := Caption + 'bad weather, ';
end)
end;
end);
end;
I want to use a TParallel.&For loop to calculate, for example, the prime numbers between 1 and 100000 and save all these prime numbers in AList: TList<Integer>:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
AList: TList<Integer>;
LoopResult: Tparallel.TLoopResult;
begin
AList:=TList<Integer>.Create;
TParallel.&For(1, 100000,
procedure(AIndex: Integer)
begin
if IsPrime(AIndex) then
begin
//add the prime number to AList
end;
end);
//show the list
for i := 0 to AList.Count-1 do
begin
Memo1.Lines.Add(IntToStr(AList[i]));
end;
end;
The calculations can be performed in parallel without issue but the TList is a shared resource. How can I add confirmed primes to the list in a threadsafe way?
You would simply call AList.Add(AIndex), and then Sort() the list after the loop is finished. But TList is not thread-safe, so you need a lock around the Add(), like a TCriticalSection or TMutex:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
AList: TList<Integer>;
ALock: TCriticalSection;
LoopResult: TParallel.TLoopResult;
begin
AList := TList<Integer>.Create;
ALock := TCriticalSection.Create;
TParallel.&For(1, 100000,
procedure(AIndex: Integer)
begin
if IsPrime(AIndex) then
begin
ALock.Enter;
try
AList.Add(AIndex);
finally
ALock.Leave;
end;
end;
end);
AList.Sort;
for i := 0 to AList.Count-1 do
begin
Memo1.Lines.Add(IntToStr(AList[i]));
end;
ALock.Free;
AList.Free;
end;
Or use TThreadList<T> instead:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
AList: TThreadList<Integer>;
LList: TList<Integer>;
LoopResult: TParallel.TLoopResult;
begin
AList := TThreadList<Integer>.Create;
TParallel.&For(1, 100000,
procedure(AIndex: Integer)
begin
if IsPrime(AIndex) then
begin
AList.Add(AIndex);
end;
end);
LList := AList.LockList;
try
LList.Sort;
for i := 0 to LList.Count-1 do
begin
Memo1.Lines.Add(IntToStr(LList[i]));
end;
finally
AList.UnlockList;
end;
AList.Free;
end;