Record the value in the field through RTTI - delphi

We need to create a class using rtti with preset values. The values are taken from the attribute. All seems fine works exactly the time when you need to add value in the field. Find the right property and gets the value of the attribute is true. But the record is not operated. Tell me where wrong?
program DemoGenerator;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.Rtti;
Type
// My attribute
DemoDataAttribute = class(TCustomAttribute)
private
FGenerator: String;
public
constructor Create(Generator: String);
published
property Generator: string read FGenerator write FGenerator;
end;
//
TSomeType = Class
private
fPhone: string;
published
[DemoData('+1800764328')]
property Phone: string read fPhone write fPhone;
End;
//
TMegaSuperClass = Class
Function Go<T: Class, constructor>: T;
End;
Procedure Test;
var
LMsc: TMegaSuperClass;
New: TSomeType;
Begin
LMsc := TMegaSuperClass.Create;
try
New := LMsc.Go<TSomeType>;
Writeln('New.Phone: ' + New.Phone);
finally
LMsc.Free;
// New.Free;
end;
End;
{ DemoDataAttribute }
constructor DemoDataAttribute.Create(Generator: String);
begin
FGenerator := Generator;
end;
{ TMegaSuperClass }
function TMegaSuperClass.Go<T>: T;
var
LContext: TRttiContext;
LClass: TRttiInstanceType;
LProp: TRttiProperty;
LAttr: TCustomAttribute;
LField: TRttiField;
begin
// Init Rtti
LContext := TRttiContext.Create;
LClass := LContext.GetType(T) as TRttiInstanceType;
Writeln('LClass: ' + LClass.ToString);
// Result
Result := T.Create;
for LProp in LClass.GetProperties do
begin
Writeln('LProp: ' + LProp.ToString);
for LAttr in LProp.GetAttributes do
begin
Writeln('LAttr: ' + LAttr.ToString);
if LAttr is DemoDataAttribute then
Begin
Writeln('Attr value: ' + DemoDataAttribute(LAttr).Generator);
// How write value?
LProp.SetValue(#Result, DemoDataAttribute(LAttr).Generator);
End;
end;
end;
end;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
Test;
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Console output:
TSomeType
property Phone: string
DemoDataAttribute
value: +1800764328
Phone:

Like this:
LProp.SetValue(Pointer(Result), DemoDataAttribute(LAttr).Generator);
The first argument to SetValue is declared as Instance: Pointer. A class reference is simply the pointer to the instance, which is what you want.

Related

Unexpected failure of custom registered Reverter using TJSONUnMarshal

The code below is from the JSonMarshall project in chapter 7 of Marco Cantu's Delphi 2010 Handbook. The source code is available from here http://cc.embarcadero.com/item/27600. I have made two changes to it:
Add JSon to the implementation Uses clause to get it to compile.
Added the line
theName := 'XXX'; // added by me
to the TDataWithList.Create constructor to assist debugging
I am running the code in Delphi Seattle (without update 1)
The purpose of the project is to demo a custom converter and reverter for the TDataWithList declared type. The custom converter seems to work fine, judging by the result output to Memo1.
However, attempting to run the reverter results in a "Read of address 00000000" AV on the line
sList.Add (Args[I]);
in btnUnmarshalReverterClick. The immediate cause of this is that contrary to what
the author evidently intended, when the above line executes, sList is Nil.
My question is simply why is sList Nil and how to fix this problem?
I have tried, not entirely successfully, to trace through the DBXJSONReflect source
to find out why.
After
Obj := ObjectInstance(FRTTICtx, objType);
in function TJSONUnMarshal.CreateObject, TDataWithList(obj).theName is 'XXX'
as I'd expect and TDataWithList(obj).theLList is an initialized, but empty,
TStringList.
However, by the time the anonymous method in btnUnmarshalReverterClick is called, TDataWithList(Data).theList is Nil.
Update: The reason that TDataWithList(Data).theList (incorrectly, imo) becomes Nil is that it is set to Nil in TJSONPopulationCustomizer.PrePopulate by a call to PrePopulateObjField. So I suppose the question is, why does PrePopulate allow an object's field which has been initialized in its constructor to be overwritten as if it knows better that the object's constructor.
Update2:
There may be an additional problem, in that as far as I can tell, in
TInternalJSONPopulationCustomizer.PrePopulateObjField, the assignment which overwrites TListWithData.theList with Nil, namely
rttiField.SetValue(Data, TValue.Empty);
does not seem to result in the TStringlist destructor being called.
Btw, I get the same error running the project in XE4, which is the earliest version I have which includes JSonUnMarshal.
Code:
type
[...]
TDataWithList = class
private
theName: String;
theList: TStringList;
public
constructor Create (const aName: string); overload;
constructor Create; overload;
function ToString: string; override;
destructor Destroy; override;
end;
[...]
procedure TFormJson.btnMarshalConverterClick(Sender: TObject);
var
theData: TDataWithList;
jMarshal: TJSONMarshal;
jValue: TJSONValue;
begin
theData := TDataWithList.Create('john');
try
jMarshal := TJSONMarshal.Create(
TJSONConverter.Create); // converter is owned
try
jMarshal.RegisterConverter(TDataWithList, 'theList',
function (Data: TObject; Field: string): TListOfStrings
var
I: Integer;
sList: TStringList;
begin
sList := TDataWithList(Data).theList;
SetLength(Result, sList.Count);
for I := 0 to sList.Count - 1 do
Result[I] := sList[I];
end);
jValue := jMarshal.Marshal(theData);
try
Memo1.Lines.Text := jValue.ToString;
finally
jValue.Free;
end;
finally
jMarshal.Free;
end;
finally
theData.Free;
end;
end;
procedure TFormJson.btnUnmarshalReverterClick(Sender: TObject);
var
jUnmarshal: TJSONUnMarshal;
jValue: TJSONValue;
anObject: TObject;
begin
jValue := TJSONObject.ParseJSONValue(
TEncoding.ASCII.GetBytes (Memo1.Lines.Text), 0);
try
jUnmarshal := TJSONUnMarshal.Create;
try
jUnmarshal.RegisterReverter(TDataWithList, 'theList',
procedure (Data: TObject; Field: string; Args: TListOfStrings)
var
I: Integer;
sList: TStringList;
begin
sList := TDataWithList(Data).theList;
for I := 0 to Length(Args) - 1 do
sList.Add (Args[I]);
end);
anObject := jUnmarshal.Unmarshal(jValue);
try
ShowMessage ('Class: ' + anObject.ClassName +
sLineBreak + anObject.ToString);
finally
anObject.Free;
end;
finally
jUnmarshal.Free;
end;
finally
jValue.Free;
end;
end;
function TMyData.ToString: string;
begin
Result := theName + ':' + IntToStr (theValue);
end;
{ TDataWithList }
constructor TDataWithList.Create(const aName: string);
var
I: Integer;
begin
theName := aName;
theList := TStringList.Create;
for I := 0 to 9 do
theList.Add(IntToStr (Random (1000)));
end;
constructor TDataWithList.Create;
begin
// core initialization, used for default construction
theName := 'XXX'; // added by me
theList := TStringList.Create;
end;
destructor TDataWithList.Destroy;
begin
theList.Free;
inherited;
end;
function TDataWithList.ToString: string;
begin
Result := theName + sLineBreak + theList.Text;
end;
rttiField.SetValue(Data, TValue.Empty); simply overrides the field value because as the name implies it's a field, not a property with get / set methods. The destructor of TStringList is not called due to simple pointer assignment.
The solution here is to declare a property:
TDataWithList = class
...
strict private
theList: TStringList;
...
public
property Data: TStringList read ... write SetData
...
end;
TDataWithList.SetData(TStringList aValue);
begin
theList.Assign(aValue);
end;

How to populate memtables from enumarations?

I use memtables to wire enumerated type with comboboxes using LiveBinding.
However I have a lot of them and they way I am doing is way too bad (copy/paste)
For example, I have the following enumeration:
TEnumResourceType = (trtApp, trtTab, trtSection, trtField, trtCommand, trtOther);
and for that I created a function to give the string equivalent:
function EnumResourceTypeToStr(AEnum: TNaharEnumResourceType): string;
begin
case AEnum of
trtApp : result := 'Aplicação';
trtTab : result := 'Pagina (Tab)';
trtSection : result := 'Secção';
trtField : result := 'Campo';
trtCommand : result := 'Comando';
trtOther : result := 'Outro';
end;
end;
In a datamodule I place my memtable and I need to populate it, I am using the AFTEROPEN event of the table with the following code:
procedure TDMGlobalSystem.vtResourceTypeAfterOpen(DataSet: TDataSet);
var
enum : TEnumResourceType;
begin
inherited;
for enum := Low(TEnumResourceType) to High(TEnumResourceType) do
DataSet.InsertRecord([EnumResourceTypeToStr(enum), Ord(enum)]);
end;
All that works, however I need to do that for each new enumaration and I have dozens. Eventually I will need to change my current memtable to other and that is an added concern to automate the process. The current memtable sometimes does not work on Android.
I am looking in a way to automate this process, or using generics, or whatever, that in the DataModule I only need something like: PopulateEnum(Table, Enum);
The best solution would be creating a component inherited from this memtable and somehow define what is the enum required and all the magic happens (including the selection of the enumtostr)
Here is a generic wrapper for enums to get an array of integer,string pair representing the ordinal value and the name for the enums.
A little test
program so_24955704;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
EnumValueStore in 'EnumValueStore.pas';
type
TEnumResourceType = ( trtApp, trtTab, trtSection, trtField, trtCommand, trtOther );
procedure PrintEnumValueStore( AEnumValueStore : TEnumValueStore );
var
LEnumValuePair : TEnumValuePair;
begin
for LEnumValuePair in AEnumValueStore.GetKeyValues do
begin
Writeln( LEnumValuePair.Key, '-', LEnumValuePair.Value );
end;
end;
procedure TestEnum;
var
LEnumValueStore : TEnumValueStore<TEnumResourceType>;
begin
LEnumValueStore := TEnumValueStore<TEnumResourceType>.Create;
try
// print default names
PrintEnumValueStore( LEnumValueStore );
WriteLn;
// set the custom names
LEnumValueStore.SetValue( trtApp, 'Aplicação' );
LEnumValueStore.SetValue( trtTab, 'Pagina (Tab)' );
LEnumValueStore.SetValue( trtSection, 'Secção' );
LEnumValueStore.SetValue( trtField, 'Campo' );
LEnumValueStore.SetValue( trtCommand, 'Comando' );
LEnumValueStore.SetValue( trtOther, 'Outro' );
// print the default values
PrintEnumValueStore( LEnumValueStore );
finally
LEnumValueStore.Free;
end;
end;
begin
try
TestEnum;
except
on E : Exception do
Writeln( E.ClassName, ': ', E.Message );
end;
ReadLn;
end.
will produce the following output
0-App
1-Tab
2-Section
3-Field
4-Command
5-Other
0-Aplicação
1-Pagina (Tab)
2-Secção
3-Campo
4-Comando
5-Outro
and here is the unit that will do the work
unit EnumValueStore;
interface
uses
System.Generics.Collections;
type
TEnumValuePair = TPair<Integer, string>;
TEnumValueStore = class abstract
public
function GetKeyValues : TArray<TEnumValuePair>; virtual; abstract;
end;
TEnumValueStore<TEnumKey> = class( TEnumValueStore )
private
FValueDict : TDictionary<TEnumKey, string>;
public
constructor Create;
destructor Destroy; override;
procedure SetValue( AKey : TEnumKey; const AValue : string );
function GetKeyValues : TArray<TEnumValuePair>; override;
end;
implementation
uses
SimpleGenericEnum;
{ TEnumValueStore<TEnumKey> }
constructor TEnumValueStore<TEnumKey>.Create;
begin
inherited Create;
FValueDict := TDictionary<TEnumKey, string>.Create;
end;
destructor TEnumValueStore<TEnumKey>.Destroy;
begin
FValueDict.Free;
inherited;
end;
function TEnumValueStore<TEnumKey>.GetKeyValues : TArray<TEnumValuePair>;
var
LEnum : TEnum<TEnumKey>;
LMin, LMax : Integer;
LCount : Integer;
LIdx : Integer;
LStr : string;
begin
LMin := LEnum.Ord( LEnum.Low );
LMax := LEnum.Ord( LEnum.High );
LCount := LMax - LMin + 1;
SetLength( Result, LCount );
LCount := 0;
for LIdx := LMin to LMax do
begin
LEnum := LIdx;
if FValueDict.ContainsKey( LEnum )
then
LStr := FValueDict[LEnum]
else
LStr := LEnum;
Result[LCount] := TEnumValuePair.Create( LEnum, LStr );
Inc( LCount );
end;
end;
procedure TEnumValueStore<TEnumKey>.SetValue( AKey : TEnumKey; const AValue : string );
begin
FValueDict.AddOrSetValue( AKey, AValue );
end;
end.
I use the unit SimpleGenericEnum but there is a small bug inside you need to correct
class function TEnum<T>.High: T;
begin
// original code
// Result := Cast(_TypeData.MaxValue);
Result := Cast(GetTypeData.MaxValue);
end;
class function TEnum<T>.Low: T;
begin
// original code
// Result := Cast(_TypeData.MinValue);
Result := Cast(GetTypeData.MinValue);
end;
I would have said you have two easier choices here
Your could replace EnumResourceTypeToStr(enum) with GetEnumName(TypeInfo(TEnumResourceType), ord(enum)) or some variation on it. This has the disadvantage that it simply returns the enum as it appears in your program.
Alternatively add a constant EnumNames: array [TEnumResourceType] of string = ('.... etc. populated with your list of strings. These can then be accessed as EnumNames[enum]. This allows you arbitrary strings and the compiler will remind you to add additional entries if you extend the enumeration.

Delphi static method of a class returning property value

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.

sending a record type as parameter using dwscript

Please consider this record:
Type
TStudent = record
Name:String;
Age: Integer;
Class:String;
end;
I have a class TSchool that has the following function:
function AddStudent(LStudent:TStudent):Boolean;
I want to use this class (TSchool) in the dwsunit, and this function too, but i can't figure out how to send the record type as parameter.
This is how far i've reached:
procedure TForm1.dwsUnitClassesTSchoolMethodsAddStudentEval(Info: TProgramInfo;
ExtObject: TObject);
begin
Info.ResultAsBoolean:=(ExtObject as TSchool).AddStudent(Info.Vars['LStudent'].Value);
end;
but this is not working, it keeps on giving me error about incompatible types.
I have also defined in the dwsunit a record TSchool, but this didn't work either.
Any Help is appreciated.
I don't have Delphi 2010 at my disposal now, but I do have Delphi XE(it should work in D2010 also), so here's what works for me, you can of course modify to fit your needs:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,dwsComp
,dwsCompiler
,dwsExprs
,dwsCoreExprs
,dwsRTTIExposer
,Generics.Collections
;
// required
{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished])}
{M+}
type
// student definition
TStudent = record
Name: string;
Age: Integer;
AClass: string;
end;
// student list, we use generics
TStudentList = class(TList<TStudent>);
// school class
TSchool = class(TObject)
private
FStudentList: TStudentList;
published
constructor Create;
destructor Destroy; override;
published
procedure AddStudent(AStudent: TStudent);
function GetStudentCount: Integer;
function GetStudent(Index: Integer): TStudent;
end;
{ TSchool }
procedure TSchool.AddStudent(AStudent: TStudent);
begin
FStudentList.Add(AStudent);
end;
constructor TSchool.Create;
begin
FStudentList := TStudentList.Create;
end;
function TSchool.GetStudentCount: Integer;
begin
Result := FStudentList.Count;
end;
function TSchool.GetStudent(Index: Integer): TStudent;
begin
Result := FStudentList[ Index ];
end;
destructor TSchool.Destroy;
begin
FStudentList.Free;
inherited;
end;
procedure TestRecords;
var
LScript: TDelphiWebScript;
LUnit: TdwsUnit;
LProg: IdwsProgram;
LExec: IdwsProgramExecution;
begin
LScript := TDelphiWebScript.Create(NIL);
LUnit := TdwsUnit.Create(NIL);
try
LUnit.UnitName := 'MySuperDuperUnit';
LUnit.Script := LScript;
// expose TStudent record to the script
LUnit.ExposeRTTI(TypeInfo(TStudent));
// expose TSchool class to script
LUnit.ExposeRTTI(TypeInfo(TSchool));
// compile a simple script
LProg := LScript.Compile(
'var LSchool := TSchool.Create;'#$D#$A +
'var LStudent: TStudent;'#$D#$A +
'var Index: Integer;'#$D#$A +
'for Index := 0 to 10 do begin'#$D#$A +
'LStudent.Name := Format(''Student #%d'', [Index]);'#$D#$A +
'LStudent.Age := 10 + Index;'#$D#$A +
'LStudent.AClass := ''a-4'';'#$D#$A +
'LSchool.AddStudent( LStudent );'#$D#$A +
'end;'#$D#$A +
'PrintLn(Format(''There are %d students in school.'', [LSchool.GetStudentCount]));'#$D#$A +
'LStudent := LSchool.GetStudent( 5 );'#$D#$A +
'PrintLn(''6th student info:'');'#$D#$A +
'PrintLn(Format(''Name: %s''#$D#$A''Age: %d''#$D#$A''AClass: %s'', [LStudent.Name, LStudent.Age, LStudent.Aclass]));'
);
if LProg.Msgs.HasErrors then begin
Writeln(LProg.Msgs.AsInfo);
Exit;
end;
try
LExec := LProg.Execute;
except
on E: Exception do
WriteLn(E.Message + #$D#$A + LExec.Msgs.AsInfo );
end;
Writeln(LExec.Result.ToString);
finally
LScript.Free;
end;
end;
begin
try
Writeln('press enter to begin');
Readln;
TestRecords;;
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

Delphi extract key from TObjectDictionary

sharing the code on this question as reference: Delphi TPair Exception
How can I retrieve the key and value from a TObjectDictionary concrete entry without using TPair and without extracting/remove/delete the pair from the list ?
{$APPTYPE CONSOLE}
uses
SysUtils,
Generics.Defaults,
Generics.Collections;
type
TProduct = class
private
FName: string;
procedure SetName(const Value: string);
published
public
property Name: string read FName write SetName;
end;
type
TListOfProducts = TObjectDictionary<TProduct, Integer>;
{ TProduct }
procedure TProduct.SetName(const Value: string);
begin
FName := Value;
end;
var
MyDict: TListOfProducts;
MyProduct1: TProduct;
MyProduct2: TProduct;
MyProduct3: TProduct;
APair: TPair<TProduct, Integer>;
aKey: string;
begin
try
MyDict := TListOfProducts.Create([doOwnsKeys]);
MyProduct1 := TProduct.Create;
MyProduct1.Name := 'P1';
MyProduct2 := TProduct.Create;
MyProduct2.Name := 'P2';
MyProduct3 := TProduct.Create;
MyProduct3.Name := 'P3';
MyDict.Add(MyProduct1, 1);
MyDict.Add(MyProduct2, 2);
MyDict.Add(MyProduct3, 3);
//the code to look for a **concrete product** (ie: MyProduct1) goes here..
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Thanks.
=========================
= Code with the answer =
{$APPTYPE CONSOLE}
uses
SysUtils,
Generics.Defaults,
Generics.Collections;
type
TProduct = class
private
FName: string;
procedure SetName(const Value: string);
published
public
property Name: string read FName write SetName;
end;
type
TListOfProducts = TObjectDictionary<TProduct, Integer>;
{ TProduct }
procedure TProduct.SetName(const Value: string);
begin
FName := Value;
end;
var
MyDict: TListOfProducts;
MyProduct1: TProduct;
MyProduct2: TProduct;
MyProduct3: TProduct;
MySearchedProduct: TProduct; // From Answer.
APair: TPair<TProduct, Integer>;
aProductName: string;
begin
try
MyDict := TListOfProducts.Create([doOwnsKeys]);
MyProduct1 := TProduct.Create;
MyProduct1.Name := 'P1';
MyProduct2 := TProduct.Create;
MyProduct2.Name := 'P2';
MyProduct3 := TProduct.Create;
MyProduct3.Name := 'P3';
MyDict.Add(MyProduct1, 1);
MyDict.Add(MyProduct2, 2);
MyDict.Add(MyProduct3, 3);
Writeln('Enter the Product Name to search: ');
//the code to look for a **concrete product** goes here..
Readln(aProductName);
for MySearchedProduct in Mydict.Keys do
if (MySearchedProduct.Name = aProductName) then
break;
if MySearchedProduct.Name = aProductName then
WriteLn('I have found the product: ' + MySearchedProduct.Name)
else
WriteLn('I have not found a product with that name.');
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
You can use The Keys and Values properties of MyDict.
In a loop like this:
var
MyProduct: TProduct;
Value: Integer;
begin
for Value in MyDict.Values do
writeln(Value);
for MyProduct in MyDict.Keys do
writeln(MyProduct.Name);
Or by index using ToArray:
writeln(MyDict.Keys.ToArray[1].Name);
writeln(MyDict.Values.ToArray[1]);
The Key and Value are saved in the dictionary as a TPair<TKey,TValue>. If you need to work with both key and value, the logical thing to do is use a TPair;
Looks like this:
for APair in MyDict do
begin
// Your stuff goes here.
end;
If for some reason you don't want to use TPair to extract the pairs you may use something like this, but this is absolutely not a good idea - you're doing lots of dictionary queries for no good reason:
for AKey in MyDict.Keys do
begin
AValue := MyDict[AKey];
// Do something with both AKey and AValue
end;
Looping through the keys could be extrimely slow if your dictionary contains lots of members. I suggest keeping the key in the Pair along with the real value. Considering the example provided it might look like this:
type
TListOfProducts = TObjectDictionary<TProduct, TPair<TProduct,Integer>>;

Resources