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.
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;
I have several threads, each with its own TEvent:
TWorkerThread = class(TThread)
private
FSignal: TEvent;
public
constructor Create;
destructor Destroy; override;
procedure Execute; override;
end;
procedure TWorkerThread.Execute;
var ID: integer;
begin
while not Terminated do begin
Tmonitor.Enter(MainQueue);
try
if (MainQueue.Count > 0) then ID := MainQueue.dequeue
else ID := 0;
finally
Tmonitor.exit(MainQueue);
end;
if (ID <> 0) then ProcessID(ID)
else fSignal.WaitFor(INFINITE);
end;
end;
Now, in the main thread I would like to retrieve the list of threads that are waiting for the signal, so those who are doing fSignal.WaitFor(INFINITE);
Actually I do like this in the code:
procedure AddIDToTheQueue(const id: integer);
begin
Tmonitor.Enter(MainQueue);
try
MainQueue.Enqueue(id);
//signal all background thread !!! this a don't like i prefer to signal only one thread who are waiting instead of signaling all the threads !!!
for I := Low(workerThreads) to High(workerThreads) do
workerThreads[i].Signal.SetEvent;
finally
Tmonitor.Exit(MainQueue);
end;
end;
but it's not efficient as I signal all threads instead of signalling only the first one that is waiting for the signal. How can I do this?
To directly answer your question, you can always check if an event is signalled using :
if FSignal.WaitFor(0) = wrSignaled then begin
// event is signaled
end;
If you need to handle all cases, of course :
case FSignal.WaitFor(0) of
wrSignaled:;
wrTimeout:;
wrAbandoned:;
wrError:;
wrIOCompletion:;
end;
However - this is an ideal situation to leverage the built-in threadpool by simply using tasks.
For example, all of your code can be eliminated and reduced to this :
procedure AddIDToTheQueue(id: integer);
var
LTask : ITask;
begin
LTask := TTask.Create(procedure begin ProcessID(id); end);
LTask.Start;
end;
There is no sense in passing an integer as const. Whether you pass the value or a pointer, it's the same size. If you're not modifying it, it makes no difference.
I would not use events in this situation.
I would use yield.
Then Execute becomes
procedure TWorkerThread.Execute;
var
ID : integer;
begin
while not Terminated do begin
Tmonitor.Enter(MainQueue);
try
if (MainQueue.Count > 0) then ID := MainQueue.dequeue
else ID := 0;
finally
Tmonitor.exit(MainQueue);
end;
if (ID <> 0) then ProcessID(ID)
else Yield;
end;
end;
and AddIDToTheQueue becomes
procedure AddIDToTheQueue(const id: integer);
begin
Tmonitor.Enter(MainQueue);
try
MainQueue.Enqueue(id);
finally
Tmonitor.Exit(MainQueue);
end;
end;
You are not attempting to tell your threads that a new ID is available. You are letting the first available thread handle it automatically.
Calling TEvent.WaitFor(0) it's a bit slower... You cand make a new beautiful Event that uses Critical Section to fast check for singaled state. In this example, I also added a value to the event which can help you send a command with that signal too.
TSafeCardinalEvent = class
private
CardinalValue: Cardinal;
CS: TRTLCriticalSection;
hEvent: THandle;
function GetEventValue: Cardinal;
procedure SetEventValue(AValue: Cardinal);
public
constructor Create; virtual;
destructor Destroy; override;
function Signaled: Boolean; overload; {$IFDEF RELEASE} inline; {$ENDIF}
function Signaled(out Code: Cardinal): Boolean; overload;
property Value: Cardinal read GetEventValue write SetEventValue;
property EventHandle: THandle read hEvent;
end;
constructor TSafeCardinalEvent.Create;
begin
inherited Create;
CardinalValue:= 0;
InitializeCriticalSection(CS);
hEvent:= CreateEvent(nil, True, False, nil);
end;
destructor TSafeCardinalEvent.Destroy;
begin
CloseHandle(hEvent);
DeleteCriticalSection(CS);
inherited Destroy;
end;
function TSafeCardinalEvent.Signaled: Boolean;
begin
EnterCriticalSection(CS);
Result:= CardinalValue > 0;
LeaveCriticalSection(CS);
end;
function TSafeCardinalEvent.Signaled(out Code: Cardinal): Boolean;
begin
EnterCriticalSection(CS);
Code:= CardinalValue;
Result:= CardinalValue > 0;
LeaveCriticalSection(CS);
end;
function TSafeCardinalEvent.GetEventValue: Cardinal;
begin
EnterCriticalSection(CS);
Result:= CardinalValue;
LeaveCriticalSection(CS);
end;
procedure TSafeCardinalEvent.SetEventValue(AValue: Cardinal);
begin
EnterCriticalSection(CS);
CardinalValue:= AValue;
if CardinalValue = 0
then ResetEvent(hEvent)
else SetEvent(hEvent);
LeaveCriticalSection(CS);
end;
Using Delphi 2010
Hi, I am looking for a way to break out of a loop using a key press (example 'x')
procedure TfrmMain.btnSpinClick(Sender: TObject);
function IsControlKeyPressed: Boolean;
begin
Result := GetKeyState(Ord('x')) < 0;
end;
var
ProductList: TStringList;
I, Integer;
begin
Screen.Cursor:= crHourGlass;
Spinning:= True;
UpdateAll;
Application.ProcessMessages;
//create a product list
ProductList:= TStringList.Create;
ProductList.LoadFromFile(edtProductsFile.Text);
Progressbar1.Min:= 1;
Progressbar1.Max:= ProductList.Count - 1;
//interate through the product list
//skip first line (its the field names) and start at the second line
for I:= 1 to ProductList.Count - 1 do
begin
//***************
//other code here
//***************
Progressbar1.Position:= Progressbar1.Position + 1;
***if IsControlKeyPressed then Break;
Application.ProcessMessages;***
end; //for I:= 1 to ProductList.Count - 1 do
ProductList.Clear;
ProductList.Free;
Thesaurus.Clear;
Thesaurus.Free;
Screen.Cursor:= crDefault;
Spinning:= False;
UpdateAll;
Application.ProcessMessages;
end;
Move your long-running code into a separate thread. In it, occasionally check whether a certain flag is set. When it's set, stop.
Then, write an OnKeyPress event handler for your form. When that event handler detects that the magic key combination has been pressed, set the flag. That will cause the thread to stop doing its work.
It could work something like this:
type
TProcessProductListThread = class(TThread)
private
FFileName: string;
FProgressBar: TProgressBar;
FMax: Integer;
procedure SetProgressBarRange;
procedure IncrementProgressBar;
procedure ProcessProduct(const AProduct: string);
protected
procedure Execute; override;
public
constructor Create(const AFileName: string; AProgressBar: TProgressBar;
OnThreadTerminate: TNotifyEvent);
end;
The constructor receives all the information it will need to do its work, but doesn't actually start doing any of it. That's reserved for the Execute method. We set FreeOnTerminate := False because the main thread will need to continue to have access to the thread object after it's begun running.
constructor TProcessProductListThread.Create(const AFileName: string;
AProgressBar: TProgressBar; OnThreadTerminate: TNotifyEvent);
begin
inherited Create(False);
FFileName := AFileName;
FProgressBar := AProgressBar;
OnTerminate := OnThreadTerminate;
FreeOnTerminate := False;
end;
Your code interacts with the GUI in a couple of places. That needs to happen from the GUI thread, so we'll extract that code into separate methods that can be passed to Synchronize:
procedure TProcessProductList.SetProgressBarRange);
begin
FProgressBar.Min := 1;
FProgressBar.Position := FProgressBar.Min;
FProgressBar.Max := FMax;
end;
procedure TProcessProduceList.IncrementProgressBar;
begin
FProgressBar.Position := FProgressBar.Position + 1;
end;
You'll notice that the Execute method looks similar to your original code. Notice how it uses the values previously saved from the constructor.
procedure TProcessProductList.Execute;
var
ProductList: TStringList;
I: Integer;
begin
ProductList := TStringList.Create;
try
ProductList.LoadFromFile(FFileName);
FMax := ProductList.Count - 1;
Synchronize(SetProgressBarRange);
// skip first line (it's the field names) and start at the second line
for I := 1 to ProductList.Count - 1 do begin
ProcessProduct(ProductList[I]);
Synchronize(IncrementProgressBar);
if Terminated then
exit;
end;
finally
ProductList.Free;
end;
end;
To start the thread, create it like this:
ProcessThread := TProcessProductList.Create(edtProductsFile.Text, Progressbar1,
OnProcessProductListTerminate);
Handle the termination with an event handler like below. It's mostly the stuff from the epilogue of your original code, but it also clears ProcessThread; that way, its value can indicate whether the thread is still running.
procedure TForm1.OnProcessProductListTerminate(Sender: TObject);
begin
Thesaurus.Clear;
Thesaurus.Free;
UpdateAll;
ProcessThread := nil;
end;
Remember that I said you should set a flag when the key is pressed? In the code above, the flag it checks is simply the thread's own Terminated property. To set it, call the thread's Terminate method.
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Char = 'X' then begin
ProcessThread.Terminate;
ProcessThread.Free;
Char := #0;
end;
end;
Overview:
I have an application were we want to listen/test events, the ideal is
to pass an event name to a stored procedure and be able to report
back it event was successful and/or unsuccessful.
Issue:
Event is only getting executed the first time, subsequent event don’t
get executed. (see NotifyEventAlert)
Stored Procedure:
CREATE PROCEDURE TESTEVENT(EVENTNAME VARCHAR(65))
AS
BEGIN
POST_EVENT(:EVENTNAME);
END;
NotifyEventAlert:
//Note event is only getting excuted the first time
procedure TObjApplicationEvents.NotifyEventAlert(Sender: TObject;
EventName: string; EventCount: Integer; var CancelAlerts: Boolean);
begin
if Assigned(Self.OnPostedEvent) then
Self.OnPostedEvent(Self, Eventname);
end;
EventPosting :
procedure TFrmEventProcessingTestLkp.btnTestEventClick(Sender: TObject);
var
c : TCursor;
ae : TObjApplicationEvents;
cq : TCustomQuery;
begin
inherited;
c := Screen.Cursor;
Screen.Cursor := crHourglass;
ae := nil;
cq := nil;
try
try
ae := TObjApplicationEvents.Create;
ae.OnPostedEvent := Self.OnPostedEvent;
cq := TCustomQuery.Create(nil);
cq.StartTransaction;
cq.SetOperationType(cqotStoredProcedure);
cq.SetStoredProcName('TESTEVENT');
cq.Params.CreateParam(ftString, 'EVENTNAME', ptInput);
cq.ParamByName('EVENTNAME').Value := GetRecordColumnValue(cxColEvent.Index);
cq.ExecSQL;
cq.CommitTransaction;
Sleep(1000);
except on e: Exception do
begin
cq.RollBackTransaction;
raise Exception.Create(e.message);
end;
end;
finally
FreeAndNil(ae);
FreeAndNil(cq);
Screen.Cursor:= c;
end;
end;
If I create a (suspended) thread from the main thread as such:
with TMyThread.Create(True) do
begin
OnTerminate := ThreadTerminated;
FreeOnTerminate := False;
Start;
end;
How do I go about freeing that instance once it's completed? (ie the Execute procedure has finished executing - assume I've captured exceptions).
This Proper way of destroying a tthread object link shows a way (via the PostMessage procedure) which works fine and makes sense. However, what if I create the thread and I don't have a handle to a form or something where I can invoke the PostMessage procedure. eg I create the thread within a class descended directly from TObject?
TMyClass = class
public
procedure DoSomething;
end;
TMyClass.DoSomething;
begin
with TMyThread.Create(True) do
begin
OnTerminate := ThreadTerminated;
FreeOnTerminate := False;
Start;
end;
end;
So, I guess, how do I free a thread without access to a form handle?
Thanks
Obviously, somewhere there has to be a reference to the instantiated thread. But I can relate to your wish: you want a always-done-never-care solution.
I suggest you manage the thread's existence by a separate ThreadController class:
unit Unit2;
interface
uses
Classes, SysUtils, Forms, Windows, Messages;
type
TMyThreadProgressEvent = procedure(Value: Integer;
Proceed: Boolean) of object;
procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);
implementation
type
TMyThread = class(TThread)
private
FException: Exception;
FOnProgress: TMyThreadProgressEvent;
FProceed: Boolean;
FValue: Integer;
procedure DoProgress;
procedure HandleException;
procedure ShowException;
protected
procedure Execute; override;
end;
TMyThreadController = class(TObject)
private
FThreads: TList;
procedure StartThread(StartValue: Integer;
OnProgress: TMyThreadProgressEvent);
procedure ThreadTerminate(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
end;
var
FMyThreadController: TMyThreadController;
function MyThreadController: TMyThreadController;
begin
if not Assigned(FMyThreadController) then
FMyThreadController := TMyThreadController.Create;
Result := FMyThreadController
end;
procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);
begin
MyThreadController.StartThread(StartValue, OnProgress);
end;
{ TMyThreadController }
constructor TMyThreadController.Create;
begin
inherited;
FThreads := TList.Create;
end;
destructor TMyThreadController.Destroy;
var
Thread: TThread;
begin
while FThreads.Count > 0 do
begin
Thread := FThreads[0]; //Save reference because Terminate indirectly
//extracts the list entry in OnTerminate!
Thread.Terminate; //Indirectly decreases FThreads.Count
Thread.Free;
end;
FThreads.Free;
inherited Destroy;
end;
procedure TMyThreadController.StartThread(StartValue: Integer;
OnProgress: TMyThreadProgressEvent);
var
Thread: TMyThread;
begin
Thread := TMyThread.Create(True);
FThreads.Add(Thread); //Add to list before a call to Resume because once
//resumed, the thread might be gone already!
Thread.FValue := StartValue;
Thread.FOnProgress := OnProgress;
Thread.OnTerminate := ThreadTerminate;
Thread.Resume;
end;
procedure TMyThreadController.ThreadTerminate(Sender: TObject);
begin
FThreads.Extract(Sender);
end;
{ TMyThread }
procedure TMyThread.DoProgress;
begin
if (not Application.Terminated) and Assigned(FOnProgress) then
FOnProgress(FValue, FProceed);
end;
procedure TMyThread.Execute;
begin
try
FProceed := True;
while (not Terminated) and (not Application.Terminated) and FProceed and
(FValue < 20) do
begin
Synchronize(DoProgress);
if not FProceed then
Break;
Inc(FValue);
Sleep(2000);
end;
//In case of normal execution ending, the thread may free itself. Otherwise,
//the thread controller object frees the thread.
if not Terminated then
FreeOnTerminate := True;
except
HandleException;
end;
end;
procedure TMyThread.HandleException;
begin
FException := Exception(ExceptObject);
try
if not (FException is EAbort) then
Synchronize(ShowException);
finally
FException := nil;
end;
end;
procedure TMyThread.ShowException;
begin
if GetCapture <> 0 then
SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if (FException is Exception) and (not Application.Terminated) then
Application.ShowException(FException)
else
SysUtils.ShowException(FException, nil);
end;
initialization
finalization
FreeAndNil(FMyThreadController);
end.
To run this sample thread which counts from 5 to 19 in 2 second intervals and provides feedback and an opportunity to a premature termination, call from the main thread:
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure MyThreadProgress(Value: Integer; Proceed: Boolean);
end;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
RunMyThread(5, MyThreadProgress);
end;
procedure TForm1.MyThreadProgress(Value: Integer; Proceed: Boolean);
begin
Caption := IntToStr(Value);
end;
This thread automatically kills itself on either thread's or application's termination.
Maybe this unit is a little overkill for your situation because it is capable of handling multiple threads (of the same type), but I think it answers your question. Adjust to your liking.
Partial origin of this answer: NLDelphi.com.