I am working a custom class to xml converter and one of the requirements is the ability to stream TObjectList<T> fields.
I am trying to invoke the ToArray() method to get hold of the TObjectlist's objects, but I get 'Invalid class typecast' because the types obviously don't match.
take this class for example:
type
TSite = class
Name : String;
Address : String;
end;
TSites = class
Sites : TObjecList<TSite>;
end;
I just need to get the Site Objects from the Sites TObjectList.
Please keep in mind that I am using RTTI, so I don't know the ObjectType in TObjectList, so Typecasting won't work. This is what I have but it seems a dead end (Obj is TobjectList<TSite> here):
function TXmlPersister.ObjectListToXml(Obj : TObject; Indent: String): String;
var
TypInfo: TRttiType;
meth: TRttiMethod;
Arr : TArray<TObject>;
begin
Result := '';
TypInfo := ctx.GetType(Obj.ClassInfo);
Meth := TypInfo.GetMethod('ToArray');
if Assigned(Meth) then
begin
Arr := Invoke(Obj, []).AsType<TArray<TObject>>; // invalid class typecast error
if Length(Arr) > 0 then
begin
// get objects from array and stream them
...
end;
end;
Any way to get the objects out of the TObjectList via RTTI is good for me.
For some odd reason I don't see the GetItem/SetItem methods in TypInfo
EDIT
Thanks to David I have my solution:
function TXmlPersister.ObjectListToXml(Obj : TObject; Indent: String): String;
var
TypInfo: TRttiType;
meth: TRttiMethod;
Value: TValue;
Count : Integer;
begin
Result := '';
TypInfo := ctx.GetType(Obj.ClassInfo);
Meth := TypInfo.GetMethod('ToArray');
if Assigned(Meth) then
begin
Value := Meth.Invoke(Obj, []);
Assert(Value.IsArray);
Count := Value.GetArrayLength;
while Count > 0 do
begin
Dec(Count);
Result := Result + ObjectToXml(Value.GetArrayElement(Count).AsObject, Indent);
end;
end;
end;
I am open for suggestions, maybe there are more 'clever' ways to achieve this goal...
Your code fails because a dynamic array is not a TObject.
You can do it like this:
Value := Meth.Invoke(Obj, []);
Assert(Value.IsArray);
SetLength(Arr, Value.GetArrayLength);
for i := 0 to Length(Arr)-1 do
Arr[i] := Value.GetArrayElement(i).AsObject;
Related
How to store record to temporary variable and pass it through function?
If I have two records like:
TMyRec1 = packed record
SomeValue : Integer;
end;
TMyRec2 = packed record
ThisIsMessage : String;
end;
And now I want to be able to do something like this:
function GetRec(recId: Integer) : Variant;
begin
case (recId) of
1 : Result := TMyRec1.Create();
2 : Result := TMyRec2.Create();
//... many
else
end;
end;
And also to return it back to original type like:
function GetRec1(rec: Variant) : TMyRec1;
begin
Result := TMyRec1(rec);
// here I do lots of default things with this record type
end;
function GetRec2(rec: Variant) : TMyRec2;
begin
Result := TMyRec2(rec);
// here I do lots of default things with this record type
end;
Finally an complete function should be able to do the following:
procedure MainFunction();
var myRec : Variant; //I want to avoid to specify each T here
begin
myRec := GetRec(1);
PrintRec1(GetRec1(myRec));
myRec := GetRec(2);
PrintRec2(GetRec2(myRec));
end;
procedure PrintRec1(rec: TMyRec1);
begin
Print(IntToStr(rec.SomeValue));
end;
procedure PrintRec2(rec: TMyRec2);
begin
Print(rec.ThisIsMessage);
end;
I have tried with Variant, TObject, NativeUInt casting but nothing seem to work.
Thank you for any help.
EDIT
TMyRec = record
end;
TMyRec1 = TMyRec
SomeValue : Integer;
end;
TMyRec2 = TMyRec
ThisIsMessage : String;
end;
Can be done something like this?
I don't need safety checking and rising exceptions I will take care of that to make sure I pass correct one where required.
A record does not have a Create() constructor by default, like a class does, so TMyRec1.Create() and TMyRec2.Create() will not work as shown.
But, in Delphi 2006 and later, you can manually add a static Create() method that returns a new record instance (several of Delphi's own native RTL records do this, such as TFormatSettings, TRttiContext, etc), eg:
TMyRec1 = packed record
SomeValue : Integer;
class function Create: TMyRec1; static;
end;
TMyRec2 = packed record
ThisIsMessage : String;
class function Create: TMyRec2; static;
end;
...
class function TMyRec1.Create: TMyRec1;
begin
Result.SomeValue := ...;
end;
class function TMyRec2.Create: TMyRec2;
begin
Result.ThisIsMessage := ...;
end;
Otherwise, for earlier versions, you will have to use standalone functions, eg:
TMyRec1 = packed record
SomeValue : Integer;
end;
TMyRec2 = packed record
ThisIsMessage : String;
end;
function CreateRec1: TMyRec1;
function CreateRec2: TMyRec2;
...
function CreateRec1: TMyRec1;
begin
Result.SomeValue := ...;
end;
function CreateRec2: TMyRec2;
begin
Result.ThisIsMessage := ...;
end;
But, either way, know that by default you can't just store arbitrary record types in a Variant, it doesn't know how to store and retrieve them. You have to teach it how to do that. You do that by deriving a class from TCustomVariantType and override its various operational methods for casting, comparing, etc, and then register that class with the RTL so that the Variant infrastructure knows about it. See Defining Custom Variants in Delphi's documentation for more details about that. Only then will your GetRec(), GetRec1(), and GetRec2() functions be able to work exactly as you have coded them.
Otherwise, consider an alternative approach, for instance defining a custom tagged record, similar to how Variant works internally, eg:
PMyRec1 = ^TMyRec1;
TMyRec1 = packed record
SomeValue : Integer;
end;
PMyRec2 = ^TMyRec2;
TMyRec2 = packed record
ThisIsMessage : String;
end;
TMyRec = record
case Tag: Integer of
1 : (Rec1: PMyRec1);
2 : (Rec2: PMyRec2);
...
end;
function GetRec(recId: Integer) : TMyRec;
begin
Result.Tag := recId;
case recId of
1 : New(Result.Rec1);
2 : New(Result.Rec2);
...
else
raise ...;
end;
end;
function DisposeRec(var rec: TMyRec);
begin
case rec.Tag of
1 : Dispose(rec.Rec1);
2 : Dispose(rec.Rec2);
...
end;
rec.Tag := 0;
end;
function GetRec1(var rec: TMyRec) : TMyRec1;
begin
if rec.Tag <> 1 then raise ...;
Result := rec.Rec1^;
// here I do lots of default things with this record type
end;
function GetRec2(var rec: TMyRec) : TMyRec2;
begin
if rec.Tag <> 2 then raise ...;
Result := rec.Rec2^;
// here I do lots of default things with this record type
end;
procedure MainFunction;
var
myRec : TMyRec;
begin
myRec := GetRec(1);
try
PrintRec1(GetRec1(myRec));
finally
DisposeRec(myRec);
end;
myRec := GetRec(2);
try
PrintRec2(GetRec2(myRec));
finally
DisposeRec(myRec);
end;
end;
procedure PrintRec1(const rec: TMyRec1);
begin
Print(IntToStr(rec.SomeValue));
end;
procedure PrintRec2(const rec: TMyRec2);
begin
Print(rec.ThisIsMessage);
end;
I'm making a Delphi VCL application. There is a class TStudent where I have two static functions: one which returns last name from an array of TStudent and another one which returns the first name of the student. Their code is something like:
class function TStudent.FirstNameOf(aLastName: string): string;
var i : integer;
begin
for i := 0 to Length(studentsArray) - 1 do begin
if studentsArray[i].LastName = aLastName then
begin
result := studentsArray[i].FirstName;
Exit;
end;
end;
result := 'no match was found';
end;
class function TStudent.LastNameOf(aFirstName: string): string;
var i : integer;
begin
for i := 0 to Length(studentsArray) - 1 do begin
if studentsArray[i].FirstName = aFirstName then
begin
result := studentsArray[i].LastName;
Exit;
end;
end;
result := 'no match was found';
end;
My question is how can I avoid writing almost same code twice. Is there any way to pass the property as parameter of the functions.
You can use an anonymous method with variable capture for this linear search. This approach gives you complete generality with your predicate. You can test for equality of any field, of any type. You can test for more complex predicates for instance an either or check.
The code might look like this:
class function TStudent.LinearSearch(const IsMatch: TPredicate<TStudent>;
out Index: Integer): Boolean;
var
i: Integer;
begin
for i := low(studentsArray) to high(studentsArray) do
begin
if IsMatch(studentsArray[i]) then
begin
Index := i;
Result := True;
exit;
end;
end;
Index := -1;
Result := False;
end;
Now all you need to do is provide a suitable predicate. The definition of TPredicate<T>, from the System.SysUtils unit, is:
type
TPredicate<T> = reference to function (Arg1: T): Boolean;
So you would code your method like this:
class function TStudent.GetFirstName(const LastName: string): string;
var
Index: Integer;
IsMatch: TPredicate<TStudent>;
begin
IsMatch :=
function(Student: TStudent): Boolean
begin
Result := Student.LastName=LastName;
end;
if not LinearSearch(IsMatch, Index) then
begin
raise ...
end;
Result := studentsArray[Index].FirstName;
end;
And likewise for GetLastName.
If your Delphi does not support anonymous methods then you won't be able to use variable capture and will have to find a more convoluted approach using of object method types. However, the basic idea will be much the same.
I haven't tested it, but I believe this could be one solution.
uses TypInfo;
class function TStudent.GetProperty( propertyName: string, searchValue : Variant ) : Variant ;
var i : integer;
begin
for i := 0 to Length(studentsArray) - 1 do begin
if GetPropValue( studentsArray[i], propertyName ) = searchValue
result := GetPropValue( studentsArray[i], propertyName );
end;
// your code in case of not finding anything
end;
If you are using Delphi 2010 or later, you could use Extended RTTI:
uses
..., Rtti;
type
TStudent = class
public
FirstName: String;
LastName: String;
class function GetNameOf(const aFieldToFind, aNameToFind, aFieldToReturn: string): string;
end;
class function TStudent.GetNameOf(const aFieldToFind, aNameToFind, aFieldToReturn: string): string;
var
i : integer;
ctx: TRttiContent;
StudentType: TRttiType;
Field: TRttiField;
Value: TValue;
begin
ctx := TRttiContext.Create;
StudentType := ctx.GetType(TStudent);
Field := StudentType.GetField(aFieldToFind);
for i := 0 to Length(studentsArray) - 1 do
begin
if Field.GetValue(#studentsArray[i]).AsString = aNameToFind then
begin
Result := StudentType.GetField(aFieldToReturn).GetValue(#studentsArray[i]).AsString;
Exit;
end;
end;
Result := 'no match was found';
end;
Then you can call it like this:
FirstName := TStudent.GetNameOf('LastName', 'Smoe', 'FirstName');
LastName := TStudent.GetNameOf('FirstName', 'Joe', 'LastName');
If you restructure the TStudent record a little, everything gets easier. Instead of having multiple string fields with different names, declare an array of strings with an enumeration range.
Give the enumeration meaningful names and add a search function where the search field and result field can be specified.
Type
TStudentField = (sfFirstName,sfLastName); // Helper enumeration type
TStudent = record
Field: array[TStudentField] of String;
class function SearchNameOf(searchField: TStudentField;
const aSearchName: string; resultField: TStudentField): string; static;
end;
Here is a test example:
program ProjectTest;
{$APPTYPE CONSOLE}
Type
TStudentField = (sfFirstName,sfLastName);
TStudent = record
Field: array[TStudentField] of String;
class function SearchNameOf(searchField: TStudentField; const aSearchName: string; resultField: TStudentField): string; static;
end;
var
studentsArray : array of TStudent;
class function TStudent.SearchNameOf(searchField: TStudentField; const aSearchName: string; resultField: TStudentField): string;
var
i : integer;
begin
for i := 0 to Length(studentsArray) - 1 do begin
if (studentsArray[i].Field[searchField] = aSearchName) then
begin
Result := studentsArray[i].Field[resultField];
Exit;
end;
end;
result := 'no match was found';
end;
begin
SetLength(studentsArray,2);
studentsArray[0].Field[sfFirstName] := 'Buzz';
studentsArray[0].Field[sfLastName] := 'Aldrin';
studentsArray[1].Field[sfFirstName] := 'Neil';
studentsArray[1].Field[sfLastName] := 'Armstrong';
WriteLn(TStudent.SearchNameOf(sfFirstName,'Neil',sfLastName));
ReadLn;
end.
You could use a several properties with index specifier backed by single getter function just as you do for regular array properties:
TDefault = class(TObject)
private
class function GetProp(const FindWhat: string; FindWhere: Integer): string;
static;
protected
/// <remarks>
/// You don't really need this one. I've added it for an illustration
/// purposes.
/// </remarks>
class property Prop[const FindWhat: string; FindWhere: Integer]: string read GetProp;
public
class property A[const FindWhat: string]: string index 0 read GetProp;
class property B[const FindWhat: string]: string index 1 read GetProp;
end;
{ ... }
class function TDefault.GetProp(const FindWhat: string; FindWhere: Integer): string;
begin
case FindWhere of
0: Result := 'Hallo!';
1: Result := 'Hello!';
end;
Result := Result + ' ' + Format('searching for "%s"', [FindWhat]);
end;
As you see, the class properties are just the same as instance properties.
And I must say its a pretty bad idea to perform a search in the property getter.
using an DELPHI object List I store references to Tforms class items. After creating and inserting forms to that list, also some delete .... and other process steps are executed.
After I while It comes to that point where I need to evaluate the content of my objectlist.
aForm1 : TMyForm_1 ;
aForm2 : TMyForm_1 ;
aForm3 : TMyForm_1 ;
MyObjectList := TObjectList.create;
....
MyObjectList.add(aForm1) ; // and also the other forms , many time each ...
How many instances of forms from Type TMyform_1 are still in my list?
Looping all list elements and checking the class type is my idea to solve that task
for i := 0 ....
if (MyObjectList.items[i] is TMyForm_1) ...
Any more elegant method to solve this issue ?
Fist I need only to know is a TMyForm_1 type inside my list, second give me first position, and finally from this position ... go to next element inside this list .
TObjectList does not offer any methods that return information based on the runtime types of the members of the container. You have to write your own functionality using the is operator.
The most elegant I can think of would be this:
uses
Generics.Collections;
var
dict: TDictionary<TClass,Integer>;
obj: TObject;
i: Integer;
begin
// ...
for obj in MyObjectList do
if dict.TryGetValue(obj.ClassType, i) then
dict[obj.ClassType] := i + 1
else
dict.Add(obj.ClassType, 1);
// ...
end;
You can write a class helper for TObjectList and add a function that returns an array of items with the given type.
type
TObjectListHelper = class helper for TObjectList
function GetItemsByType<T : class> : TArray<T>;
end;
{ TObjectListHelper }
function TObjectListHelper.GetItemsByType<T> : TArray<T>;
var
LIdx : Integer;
LItem : TObject;
LCount : Integer;
begin
SetLength( Result, Self.Count );
LCount := 0;
for LIdx := 0 to Self.Count - 1 do
begin
LItem := Self.Items[LIdx];
if LItem is T then
begin
Result[LCount] := LItem as T;
Inc( LCount );
end;
end;
SetLength( Result, LCount );
end;
In your application you use it like this
var
LItem : TMyForm_1;
begin
for LItem in MyObjectList.GetItemsByType<TMyForm_1> do
begin
// do something with LItem
end;
end;
I'm kinda a Delphi-newbie and I don't get how the Sort method of a TList of Records is called in order to sort the records by ascending integer value.
I have a record like the following:
type
TMyRecord = record
str1: string;
str2: string;
intVal: integer;
end;
And a generic list of such records:
TListMyRecord = TList<TMyRecord>;
Have tried to find a code-example in the help files and found this one:
MyList.Sort(#CompareNames);
Which I can't use, since it uses classes. So I tried to write my own compare function with a little different parameters:
function CompareIntVal(i1, i2: TMyRecord): Integer;
begin
Result := i1.intVal - i2.intVal;
end;
But the compiler always throws a 'not enough parameters' - error when I call it with open.Sort(CompareIntVal);, which seems obvious; so I tried to stay closer to the help file:
function SortKB(Item1, Item2: Pointer): Integer;
begin
Result:=PMyRecord(Item1)^.intVal - PMyRecord(Item2)^.intVal;
end;
with PMyRecord as PMyRecord = ^TMyRecord;
I have tried different ways of calling a function, always getting some error...
The Sort overload you should be using is this one:
procedure Sort(const AComparer: IComparer<TMyRecord>);
Now, you can create an IComparer<TMyRecord> by calling TComparer<TMyRecord>.Construct. Like this:
var
Comparison: TComparison<TMyRecord>;
....
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal-Right.intVal;
end;
List.Sort(TComparer<TMyRecord>.Construct(Comparison));
I've written the Comparison function as an anonymous method, but you could also use a plain old style non-OOP function, or a method of an object.
One potential problem with your comparison function is that you may suffer from integer overflow. So you could instead use the default integer comparer.
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := TComparer<Integer>.Default.Compare(Left.intVal, Right.intVal);
end;
It might be expensive to call TComparer<Integer>.Default repeatedly so you could store it away in a global variable:
var
IntegerComparer: IComparer<Integer>;
....
initialization
IntegerComparer := TComparer<Integer>.Default;
Another option to consider is to pass in the comparer when you create the list. If you only ever sort the list using this ordering then that's more convenient.
List := TList<TMyRecord>.Create(TComparer<TMyRecord>.Construct(Comparison));
And then you can sort the list with
List.Sort;
The concise answer:
uses
.. System.Generics.Defaults // Contains TComparer
myList.Sort(
TComparer<TMyRecord>.Construct(
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal - Right.intVal;
end
)
);
I want to share my solution (based on the input I have gathered here).
It's a standard setup. A filedata class that holds data of a single file in a generic TObjectList. The list has the two private attributes fCurrentSortedColumn and fCurrentSortAscending to control the sort order. The AsString-method is the path and filename combined.
function TFileList.SortByColumn(aColumn: TSortByColums): boolean;
var
Comparison: TComparison<TFileData>;
begin
result := false;
Comparison := nil;
case aColumn of
sbcUnsorted : ;
sbcPathAndName: begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcSize : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<int64>.Default.Compare(Left.Size,Right.Size);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcDate : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TDateTime>.Default.Compare(Left.Date,Right.Date);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcState : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TFileDataTestResults>.Default.Compare(Left.FileDataResult,Right.FileDataResult);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
end;
if assigned(Comparison) then
begin
Sort(TComparer<TFileData>.Construct(Comparison));
// Control the sort order
if fCurrentSortedColumn = aColumn then
fCurrentSortAscending := not fCurrentSortAscending
else begin
fCurrentSortedColumn := aColumn;
fCurrentSortAscending := true;
end;
if not fCurrentSortAscending then
Reverse;
result := true;
end;
end;
I found a much simpler modified sort function to alphabetize a TList of records or nonstandard list of items.
Example
PList = ^TContact;
TContact = record //Record for database of user contact records
firstname1 : string[20];
lastname1 : string[20];
phonemobile : Integer; //Fields in the database for contact info
phonehome : Integer;
street1 : string;
street2 : string;
type
TListSortCompare = function (Item1,
Item2: TContact): Integer;
var
Form1: TForm1;
Contact : PList; //declare record database for contacts
arecord : TContact;
Contacts : TList; //List for the Array of Contacts
function CompareNames(i1, i2: TContact): Integer;
begin
Result := CompareText(i1.lastname1, i2.lastname1) ;
end;
and the function to call to sort your list
Contacts.Sort(#CompareNames);
We can use the SuperObject library to invoke methods of a certain object by its name and giving its parameters as a json string using the SOInvoker method like in this answer
I'd like to know how do I send a created object as a parameter. I tried to send it like
LObjectList := TObjectList.Create;
LSuperRttiCtx := TSuperRttiContext.Create;
LSuperObjectParameter := LObjectList.ToJson(LSuperRttiCtx);
SOInvoke(MyInstantiatedObject, 'MyMethod', LSuperObjectParameter);
but inside MyMethod the LObjectList reference is lost.
What am I doing wrong?
The superobject library can be downloaded here
It will works if you use array of records intead of object list.
If you still want to use object list you will have to write encoders and decoders like this. I have written encoder/decoder for TObjectList, you will have to do the same for your objects and embed the class name somewhere.
ctx.SerialToJson.Add(TypeInfo(TObjectList), ObjectListToJSON);
ctx.SerialFromJson.Add(TypeInfo(TObjectList), JSONToObjectList);
function ObjectListToJSON(ctx: TSuperRttiContext; var value: TValue;
const index: ISuperObject): ISuperObject;
var
list: TObjectList;
i: Integer;
begin
list := TObjectList(value.AsObject);
if list <> nil then
begin
Result := TSuperObject.Create(stArray);
for i := 0 to list.Count - 1 do
Result.AsArray.Add(encodeyourobject(list[i]));
end else
Result := nil;
end;
function JSONToObjectList(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;
var
list: TObjectList;
i: Integer;
begin
list := nil;
case ObjectGetType(obj) of
stNull:
begin
Value := nil;
Result := True;
end;
stArray:
begin
list := TObjectList.Create;
for i := 0 to obj.AsArray.Length - 1 do
list.Add(decodeyourobject(obj.AsArray[i]));
Value := list;
Result := True;
end;
else
result := False;
end;
end;