I have thoses objects :
TmyObject1=class
public
Status: integer;
end;
TmyObject2=class
public
StatusA: integer;
StatusB: integer;
end;
I have many objects like those one with many status fields declared. I would like to call a function and let the function update the value of one of the status field. quite easy I declare the function like this :
function MyFunction(var AStatus: Integer);
and I call it like this
MyFunction(myObject1.Status);
or for example
MyFunction(myObject2.StatusB);
that good but now my problem arrive, in MyFunction I create a thread and I want to let the possibility to the thread to update also the value of Status. something like this :
function MyFunction(var AStatus: Integer);
begin
MyTread.??ObjectStatus?? := AStatus;
MyTread.start;
end;
procedure TmyThread.execute;
begin
...
??ObjectStatus?? := NewStatus
...
end;
How can I do ? what type must be the TmyThread.??ObjectStatus??. I was thinking to gave to MyTread a pointer address but I m afraid that if memory relocation between the start and the end of the thread that the pointer address could become wrong (Code must work on ios/android/windows/etc.). any other options to solve my problem ?
Instead of a var parameter you can provide getter and setter to your function:
function MyFunction(GetStatus: TFunc<Integer>; SetStatus: TProc<Integer>);
begin
MyThread.GetStatus := GetStatus;
MyThread.SetStatus := SetStatus;
MyThread.start;
end;
procedure TmyThread.execute;
begin
...
OldStatus := GetStatus;
SetStaus(NewStatus);
...
end;
Calling this function requires some anonymous methods now:
MyFunction(
function: Integer
begin
result := myObject1.Status;
end,
procedure(Arg: Integer)
begin
myObject1.Status := Arg
end);
Of course you have to make sure that myObject1 is available during the thread execution.
Related
i need a function like the code below (not working! its just example)
type
TCallBack = procedure( x:String) of object;
procedur procA(CallBack : TCallBack);
begin
CallBack('hello world')
end;
and then fire the procA an pass a procedure as parameter:
procA( procedure (res : string)
begin
ShowMessage(res);
end);
From your syntax at the CALLING site, it seems like you want to declare the procedure to be called inline at the call site.
If so, you shouldn't use OF OBJECT definition but REFERENCE TO:
type
TCallBack = reference to procedure(x : String);
Then you can use your code:
procedure procA(CallBack : TCallBack);
begin
CallBack('hello world')
end;
procA(procedure (res : string)
begin
ShowMessage(res);
end);
EDIT: Sample code
type
TCallBack = reference to procedure(x : String);
procedure procA(CallBack : TCallBack);
begin
CallBack('hello world')
end;
procedure TForm59.FormCreate(Sender: TObject);
begin
procA(procedure (res : string)
begin
ShowMessage(res);
end);
end;
EDIT: Using the CallBack event from within a thread:
PROCEDURE TWebThread.Execute;
BEGIN
.
.
.
Synchronize(PROCEDURE
BEGIN
CallBack('Hello World')
END)
END;
But then you have to ensure that any variables you access from within the inline-defined procedure is still valid at the time the thread calls the callback, so don't use local variables, as they may very well have run out of scope. Also, make sure that any CLASS instances you use in the inline-defined procedure hasn't been Free'd or otherwise made invalid between the time you create the thread and the time the callback event is executed.
SITUATION. I have created an unit with some classes to solve algebra stuff (congruences and systems), I am showing you the code:
type
TCongrError = class(Exception)
end;
type
TCongruence = class(TComponent)
//code stuff
constructor Create(a, b, n: integer); virtual;
end;
type
TCongrSystem = array of TCongruence;
type
TCongruenceSystem = class(TThread)
private
resInner: integer;
FData: TCongrSystem;
function modinv(u, v: integer): integer; //not relevant
protected
procedure Execute; override;
public
constructor Create(data: TCongrSystem; var result: integer; hasClass: boolean);
end;
I have decided to use TThread because this class has an Execute method that could take some time to finish due to the length of the parameters passed to the constructor. Here's the implementation:
constructor TCongruenceSystem.Create(data: TCongrSystem; var result: integer; hasClass: boolean);
begin
inherited Create(True);
FreeOnTerminate := true;
FData := data;
setClass := hasClass;
resInner := result;
end;
procedure TCongruenceSystem.Execute;
var sysResult, i, n, t: integer;
begin
sysResult := 0;
n := 1;
//computation
Queue( procedure
begin
ShowMessage('r = ' + sysResult.ToString);
resInner := sysResult;
end );
end;
PROBLEM
If you look at the Queue you see that I am using (just as test) the ShowMessage and it is showing the correct value of sysResult. The second line by the way has some problems that I cannot understand.
The constructor has var result: integer so I can have side-effect from the passed variable and then I can assign resInner := result;. At the end (in the Queue) I am giving resInner the value of sysResult and I expect result to be updated too due to the side effect of var. Why doesn't this happen?
I have made another test changing the constructor like this:
constructor TCongruenceSystem.Create(data: TCongrSystem; result: TMemo; hasClass: boolean);
//now of course I have resInner: TMemo
And changing the Queue to this:
Queue( procedure
begin
ShowMessage('r = ' + sysResult.ToString);
resInner.Lines.Add(sysResult.ToString);
end ); //this code now works properly in both cases! (showmessage and memo)
In the constructor I am passing TMemo which is a reference and ok, but isn't the original var result: integer passed as reference too? Why then it doesn't work?
I want to do this because I'd like to do something like this:
//I put var a: integer; inside the public part of the TForm
test := TCongruenceSystem.Create(..., a, true);
test.OnTerminate := giveMeSolution;
test.Start;
test := nil;
Where giveMeSolution is just a simple procedure that uses the variable a containing the result of the system. If this is not possible what could I do? Basically the result at the end of Execute is just an integer number that has to be passed to the main thread.
I have read about ReturnValue but I am not sure how to use it.
Basically the result at the end of Execute is just an integer number that has to be passed to the main thread.
I have read about ReturnValue but I am not sure how to use it.
Using the ReturnValue property is very easy:
type
TCongruenceSystem = class(TThread)
...
protected
procedure Execute; override;
public
property ReturnValue; // protected by default
end;
procedure TCongruenceSystem.Execute;
var
...
begin
// computation
ReturnValue := ...;
end;
test := TCongruenceSystem.Create(...);
test.OnTerminate := giveMeSolution;
test.Start;
....
procedure TMyForm.giveMeSolution(Sender: TObject);
var
Result: Integer;
begin
Result := TCongruenceSystem(Sender).ReturnValue;
...
end;
Let's assume a class field FFoo : integer; ;
procedure TFoo.Foo(var x : integer);
begin
FFoo := x;
end;
Here what you are doing is assigning the value of x to FFoo. Inside the method Foo you are free to modify the value of the variable passed in as x but integers are otherwise value types that are copied on assignment. If you want to keep a reference to an external integer variable you would need to declare FFoo (or, in your case, resInner) as a PInteger (pointer to an integer). For example (simplifying) :
TCongruenceSystem = class(TThread)
private
resInner: PInteger;
protected
procedure Execute; override;
public
constructor Create(result: PInteger);
end;
where
constructor TCongruenceSystem.Create(result: PInteger);
begin
inherited Create(True);
FreeOnTerminate := true;
resInner := result;
end;
which you would call as test := TCongruenceSystem.Create(#a); and assign:
{ ** See the bottom of this answer for why NOT to use }
{ Queue with FreeOnTerminate = true ** }
Queue( procedure
begin
ShowMessage('r = ' + sysResult.ToString);
resInner^ := sysResult;
end );
The reason it works with TMemo is that classes are reference types - their variables do not hold values but rather point to the address of the object in memory. When you copy a class variable you are only copying a reference (ie: a pointer) whereas for value types the contents of the variable are copied on assignment.
With that said, there's nothing stopping you from keeping the argument typed as var x : integer and taking a reference in your constructor :
constructor TCongruenceSystem.Create(var result: Integer);
begin
inherited Create(True);
FreeOnTerminate := true;
resInner := #result; {take the reference here}
end;
but this gives the caller the impression that once the constructor is complete that you have made any modifications to the variable you intend to and they are free to dispose of the integer. Passing explicitly as PInteger gives the caller a hint that your object will keep a reference to the integer they provide and that need to ensure the underlying variable remains valid while your class is alive.
And... with all that said, I still fundamentally don't like this idea. By taking in a variable reference like this you are offloading an atypical lifetime management issue to the caller. Passing pointers is best done in place where they are used at the point of transfer only. Holding onto a foreign pointer is messy and it's too easy for mistakes to happen. A far better approach here would be to provide a completion event and have the consumer of your class attach a handler.
For example :
{ define a suitable callback signature }
TOnCalcComplete = procedure(AResult : integer) of object;
TCongruenceSystem = class(TThread)
private
Fx, Fy : integer;
FOnCalcComplete : TOnCalcComplete;
protected
procedure Execute; override;
public
constructor Create(x,y: integer);
property OnCalcComplete : TOnCalcComplete read FOnCalcComplete write FOnCalcComplete;
end;
constructor TCongruenceSystem.Create(x: Integer; y: Integer);
begin
inherited Create(true);
FreeOnTerminate := true;
Fx := x;
Fy := y;
end;
procedure TCongruenceSystem.Execute;
var
sumOfxy : integer;
begin
sumOfxy := Fx + Fy;
sleep(3000); {take some time...}
if Assigned(FOnCalcComplete) then
Synchronize(procedure
begin
FOnCalcComplete(sumOfxy);
end);
end;
Which you would then call as :
{ implement an event handler ... }
procedure TForm1.CalcComplete(AResult: Integer);
begin
ShowMessage(IntToStr(AResult));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
LCongruenceSystem : TCongruenceSystem;
begin
LCongruenceSystem := TCongruenceSystem.Create(5, 2);
LCongruenceSystem.OnCalcComplete := CalcComplete; { attach the handler }
LCongruenceSystem.Start;
end;
You'll also notice that I used Synchronize here instead of Queue. On this topic, please have a read of this question (I'll quote Remy...):
Ensure all TThread.Queue methods complete before thread self-destructs
Setting FreeOnTerminate := True in a queued method is asking for a memory leak.
I am using RemObjects DataAbstract along with Spring4d. RemObjects generates a SchemaServer_Intf.pas file that contains interfaces for every kind of table that exists in it's schema. It allows for "Strongly typed" datasets, allowing one to access a field using
(aDataSet as IMyDataSet).MyField := aValue
Here is a snapshot of one of the interfaces generated by DataAbstract
IEntiteType = interface(IDAStronglyTypedDataTable)
['{96B82FF7-D087-403C-821A-0323034B4B99}']
{ Property getters and setters }
function GetEntiteIdValue: String;
procedure SetEntiteIdValue(const aValue: String);
function GetEntiteIdIsNull: Boolean;
procedure SetEntiteIdIsNull(const aValue: Boolean);
function GetNameValue: WideString;
procedure SetNameValue(const aValue: WideString);
function GetNameIsNull: Boolean;
procedure SetNameIsNull(const aValue: Boolean);
function GetIsSystemValue: SmallInt;
procedure SetIsSystemValue(const aValue: SmallInt);
function GetIsSystemIsNull: Boolean;
procedure SetIsSystemIsNull(const aValue: Boolean);
{ Properties }
property EntiteId: String read GetEntiteIdValue write SetEntiteIdValue;
property EntiteIdIsNull: Boolean read GetEntiteIdIsNull write SetEntiteIdIsNull;
property Name: WideString read GetNameValue write SetNameValue;
property NameIsNull: Boolean read GetNameIsNull write SetNameIsNull;
property IsSystem: SmallInt read GetIsSystemValue write SetIsSystemValue;
property IsSystemIsNull: Boolean read GetIsSystemIsNull write SetIsSystemIsNull;
end;
Though, there is one problem. If you cast a dataTable like so:
aDataTable := IEntiteType(TDAMemDataTable.Create(nil));
You'll have an "Interface not supported error"
But, as soon as you do:
aDataTable.LogicalName := 'EntiteType';
aDataTable.BusinessRulesId := MyBusinessRuleID;
You can safely write
aDataTable := IEntiteType(TDAMemDataTable.Create(nil));
And you don't get any error.
So, with Spring4d, I thought of writing this in my registration unit:
aContainer.RegisterType<TDAMemDataTable>.Implements<IEntiteType>.DelegateTo(
function : TDAMemDataTable
var aDataTable : TDAMemDataTable;
begin
Result:= TDAMemDataTable.Create(nil);
Result.LogicalName := 'EntiteType';
Result.BusinessRulesId := MyBusinessRuleId;
end
)
But then, Spring4d throws (with reason) error :
Exception 'first chance' à $762D5B68. Classe d'exception ERegistrationException avec un message 'Component type "uDAMemDataTable.TDAMemDataTable" incompatible with service type "SchemaClient_Intf.IEntiteType".'. Processus EntiteREM2.exe (3088)
Is there a way to override this check?
Ok I've found a way to do that. Super simple actually :
aContainer.RegisterType<IAddress>.DelegateTo(
function : IAddress
var aTable : TDAMemDataTable;
begin
aTable := TDAMemDataTable.Create(nil);
aTable.LogicalName := nme_Address;
aTable.BusinessRulesID := RID_Address;
Result := aTable as IAddress;
end
);
Also, for people interested in registering many tables in an elegant fashion :
aContainer.RegisterType<IAddress>.DelegateTo(TableConfigurator.GetTableDelegate<IAddress>(nme_Address, RID_Address));
// Registering other tables here...
Just create some "Helper" class with this method :
class function TableConfigurator.GetTableDelegate<T>(aLogicalName, aBusinessRulesId: string): TActivatorDelegate<T>;
begin
Result := (function: T
var
aTable: TDAMemDataTable;
begin
aTable := TDAMemDataTable.Create(nil);
aTable.LogicalName := aLogicalName;
aTable.BusinessRulesID := aBusinessRulesId;
Result := T(TValue.From(aTable).AsInterface);
end);
end;
Sorry if there's the same question with mine.
In Delphi i make function like this:
function TModuleDatabase.LoadCountryList():TDictionary<integer, String>;
var
UQ: TUniQuery;
UC: TUniConnection;
CountryList: TDictionary<integer, String>;
begin
CountryList := TDictionary<integer, String>.Create;
UC := UniConnection2;
UQ := TUniQuery.Create(nil);
try
UQ.Connection := UC;
try
UQ.SQL.Clear;
UQ.SQL.Add('SELECT ID,NAME FROM COUNTRY ORDER BY NAME ASC');
UQ.Open;
while not UQ.Eof do
begin
CountryList.Add(UQ.Fields.FieldByName('ID').AsInteger,UQ.Fields.FieldByName('NAME').AsString);
UQ.Next;
end;
Result := CountryList;
except
on E:Exception do
ModuleMsgDialog.WarningMsg(E.Message);
end;
finally
UQ.Close;
UQ.Free;
CountryList.Free;
end;
end;
I separate the function to other DataModule to make me not repeat this function every time in each form. But when i call this funtion from a form:
procedure TCompanyDetailsForm.FormCreate(Sender: TObject);
var
i: Integer;
sItem: String;
CountryList: TDictionary<integer, String>;
begin
PageControl1.ActivePage := AddressTab;
CountryList := ModuleDatabase.LoadCountryList();
for i in CountryList.Keys do
begin
LocationCbbx.Items.AddObject(CountryList.Items[i],TObject(i));
end;
end;
The Problem is at CountryList.Free;. All item in dictionary already freed before use.
If i don't do free, there will make memory leaks.
How the best ways to transfer data before doing free. Or how to free value at other form or unit after call.
Thank you for your help.
You have two main options.
Option 1 – Caller provides an instantiated object
Here you let the caller take responsibility for lifetime. The caller passes in an instantiated object, the callee populates it.
procedure PopulateCountryDict(Countries: TDictionary<Integer, string>);
begin
// populate Countries here
end;
Option 2 – Caller returns a newly instantiated object, which is also populated
This is viable, but the caller has to assume responsibility for the lifetime once the callee returns. It looks like this:
function CreateAndPopulateCountryDict: TDictionary<Integer, string>;
begin
Result := TDictionary<Integer, string>.Create;
try
// populate Result here
except
Result.Free; // until this function returns, we are responsible for lifetime
raise;
end;
end;
The calling code looks like this:
var
Countries: TDictionary<Integer, string>
....
Countries := CreateAndPopulateCountryDict;
try
// do stuff with Countries
finally
Countries.Free;
end;
As an extension to David's answer there is another option using a callback
procedure LoadCountryList( ACallback : TProc<TDictionary<integer,string>> );
var
LCountryList : TDictionary<integer,string>;
begin
// create the instance
LCountryList := TDictionary<integer,string>.Create;
try
// fill the dictionary
// execute the callback
ACallback( LCountryList );
finally
// free the instance
LCountryList.Free;
end;
end;
and then use this in your code
procedure TCompanyDetailsForm.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage := AddressTab;
LoadCountryList(
procedure ( CountryList : TDictionary<integer,string> )
var
i: Integer;
begin
for i in CountryList.Keys do
begin
LocationCbbx.Items.AddObject(CountryList.Items[i],TObject(i));
end;
end );
end;
You should create dictinary in FormCreate method, and destroy or clear where do you need. Not in LoadCountryList function.
Delphi XE6 - I have a Unit (EMAIL1.pas) which does related processing. This is meant to be a standalone unit I can incorporate into multiple programs. My initial procedure is called GetDetailsFromEmailAddress. It has two parameters, an email address which I lookup and a "group of data" which will get updated, currently defined as a var. This can be a record or a class, I don't really care. It is just a group of related strings (firstname, last name, city, etc). Let's call this EmpRec.
My challenge is that this procedure creates an instance of a class (JEDI VCL HTMLParser) which uses a method pointer to call a method (TableKeyFound). This routine needs to update EmpRec. I do not want to change this code (HTMLPArser routine) to add additional parameters. There are several other procedures that my UNIT creates. All of them need to read/update EmpRec. How do I do this?
I need a way to "promote" the variable EmpRec which is passed in this one routine (GetDetailsFromEmailAddress) to be GLOBAL within this UNIT so that all the routines can access or change the various elements. How do I go about this? I do NOT really want to have to define this as a GLOBAL / Application wide variable.
Code sample below. So.. How does the routine TableKeyFoundEx get access to the EmpRec variable?
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
// Now create the HTML Parser...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
// On event KeyFoundEx, call Parsehandlers.TableKeyFoundEx;
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
...
end.
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo;
Attributes: TStrings);
begin
..
// NEED ACCESS to EmpRec here, but can't change procedure definition
end;
There are two different ways I would approach this:
use the parser's Tag property:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
JvHtmlParser1.Tag := NativeInt(#EmpRec);
...
end;
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(TJvHTMLParser(Sender).Tag);
...
end;
use a little TMethod hack to pass the record DIRECTLY to the event handler:
// Note: this is declared as a STANDALONE procedure instead of a class method.
// The extra DATA parameter is where a method would normally pass its 'Self' pointer...
procedure TableKeyFoundEx(Data: Pointer: Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(Data);
...
end;
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
M: TMethod;
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
M.Code := #TableKeyFoundEx;
M.Data := #EmpRec;
JvHtmlParser1.OnKeyFoundEx := TJvKeyFoundExEvent(M);
...
end;
In addition to the two options that Remy offers, you could derive a sub-class of TJvHTMLParser.
type
PEmpRec = ^TEmpRec;
TMyJvHTMLParser = class(TJvHTMLParser)
private
FEmpRec: PEmpRec;
public
constructor Create(EmpRec: PEmpRec);
end;
....
constructor TMyJvHTMLParser.Create(EmpRec: PEmpRec);
begin
inherited Create(nil);
FEmpRec := EmpRec;
end;
When you create the parser, do so like this:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
Parser: TMyJvHTMLParser;
begin
Parser := TMyJvHTMLParser.Create(#EmpRec);
try
Parser.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
....
finally
Parser.Free;
end;
end.
And in your OnKeyFoundEx you cast Sender back to the parser type to gain access to the record:
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; ...);
var
EmpRec: PEmpRec;
begin
EmpRec := (Sender as TMyJvHTMLParser).FEmpRec;
....
end;