In Delphi 7, how to get an instance of a persistent object, given the object identifier in string?
function TForm1.GetObject(Identifier: string): TPersistent;
begin
//what to do here?
end;
Example of use:
//If I have these declared...
public
MyString: string;
MyStringList: TStringList;
//the function will be used something like this
MyString:=TStringList(GetObject('MyStringList')).Text;
Thank you in advance and please apologize me for not being able to express my question clearly in English.
This is very common.
You need to hold a list of the object instances by name. You've already suggested this with your string list. This can be used to retrieve the instance by name. So:
When you create your object you do:
MyObjList := TStringList.Create;
MyObj := TMyObj.Create;
MyObjList.AddObject( 'Thing', MyObj );
MyObj2 := TMyObj.Create;
MyObjList.AddObject( 'Thing2', MyObj2 );
etc.
Now, to retrieve you simply do:
function GetObject( const AName : string ) : TMyObj;
begin
I := MyObjList.IndexOf( AName );
If I = -1 then
Raise Exception.Create( 'Cant find it' );
Result := MyObjList[I] as TMyObj;
end;
Bri
You could create a published property, which could be accessed via runtime type information (RTTI). See p.73 of Delphi in a nutshell and GetObjectProp.
Writeln((GetObjectProp(O,'ObjField') As TNamedObject).ObjectName);
Related
TDictionary : SaveToFile / LoadFromFile
What an elegant solution!
To begin with, everything runs as expected.
The content is saved to a file in a JSON format that looks right.
But after reloading the file, there is a problem:
Type
TEnumCategTypes = ( e_SQL1, e_VBA, e_Text );
TCategParams = class
fontStyles : TFontStyles;
rgbColor : COLORREF;
end;
TdictCategory = class ( TDictionary<TEnumCategTypes, TCategParams> )
public
public class function LoadFromFile( const AFileName: string ): TdictCategory;
public class procedure SaveToFile( const AFileName: string; dict: TdictCategory );
end;
implementation
class procedure TdictCategory.SaveToFile( const AFileName: string; dict: TdictCategory );
var
stream : TStringStream;
begin
try
stream := TStringStream.Create( TJson.ObjectToJsonString( dict ) ) ;
stream.SaveToFile( AFileName )
finally
stream.Free;
end;
end;
//---
class function TdictCategory.LoadFromFile( const AFileName: string ): TdictCategory;
var
stream: TStringStream;
begin
stream := TStringStream.Create;
try
stream.LoadFromFile( AFileName );
result := TJson.JsonToObject<TdictCategory>( stream.DataString );
finally
stream.Free;
end;
end;
The test follows. And all the glory ends.
Here is the code, including the comment:
..
var
cc: Colorref;
begin
.. // fill values
cc := DictCategory.Items[ e_SQL1 ].rgbColor; // Okay, it works
TdictCategory.SaveToFile( 'category.json', DictCategory ); // Even the contents of the file, looks good
DictCategory.Clear;
DictCategory.Free;
DictCategory := nil;
DictCategory := TdictCategory.LoadFromFile( 'category.json' ); // DictCategory is no longer NIL, and it looks optically well..
cc := DictCategory.Items[ e2_sql_aggregate ].rgbColor; // C R A S H !!! with AV
It seems that Delphi (Berlin 10.1), can not serialize the Dictionary! If that's true, it really hurts me. I believe there are many others. Or is there any error in the attached code?
TJson.JsonToObject ultimately will instantiate objects using their default constructor (see REST.JsonReflect.TJSONUnMarshal.ObjectInstance).
Now look into System.Generics.Collections and you will see that TDictionary<TKey,TValue> does not have a default constructor (no, RTTI has no information about default values for parameters so the constructor with Capacity: Integer = 0 will not be considered).
This means that RTTI will look further and find TObject.Create and calls that on the dictionary class which will leave you with a half initialized object (without having run your code I guess its FComparer not being assigned which the constructor of TDictionary<TKey,TValue> would have done).
Long story short: add a parameterless constructor to your TdictCategory and just call inherited Create; there. Then TJSONUnMarshal.ObjectInstance will find the parameterless constructor and calls all the code necessary to have a properly initialized instance.
Anyway you probably won't be satisfied with the result as REST.JsonReflect simply serializes all the internal states of instances (unless explicitly excluded via attributes which is not being done in the RTL classes) and thus also deserializes them which means that such JSON is only Delphi-to-Delphi compatible.
I'm trying to get variable name using RTTI like this.
Here is my test.
type
TStringHelper = record helper for string
function Name: string;
end;
TMyRecord = record
Field1:string;
end;
implementation
{ TStringHelper }
function TStringHelper.Name: string;
var
context : TRttiContext;
begin
context := TRttiContext.Create;
result := context.GetType(#Self).Name; // return empty
context.Free;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
r : TMyRecord;
begin
ShowMessage(r.Field1.Name);
end;
Name of TRttiType returning is empty.
Is there any way get variable name ?
RTTI gives information about types and not about variables. In general there is no way, using RTTI, given the address of a variable, to find its name.
Not only does RTTI not help, but what you are attempting, as a method of a string object, is not actually possible. Imagine a scenario where you have two variables referring to the same object.
S := 'foo';
T := S;
What is the name of the single string object here. Is it S or is it T?
I'm using TObjectBindSourceAdapter to use livebindings with an object.
One of the properties of the object i'm using with TObjectBindSourceAdapter has an enumerated type, but the field in the adapter is never generated when i use an enumerated type in my object
The Only solution i have found for now is to define the enumerated type as an integer in my object and typecast it. This seems to work fine but you have to keep type casting from and back the enumerated type and integers.
Here is some example code to explain what i mean.
First example which uses the enumerated type that i tried initially and does not seem to work:
uses Data.Bind.ObjectScope;
Type
TMyEnumtype = (meOne, meTwo, meThree);
TMyObject = class
public
MyEnumType: TMyEnumtype;
end;
procedure TForm9.But1Click(Sender: TObject);
var
MyObject: TMyObject;
aBindSourceAdapter: TBindSourceAdapter;
begin
MyObject := TMyObject.Create;
MyObject.MyEnumType := meTwo;
aBindSourceAdapter := TObjectBindSourceAdapter<TMyObject>.Create(nil, MyObject, False);
if aBindSourceAdapter.FindField('MyEnumType') <> nil then
ShowMessage('MyEnumType found')
else
showmessage('MyEnumType not found');
FreeAndNil(MyObject);
FreeAndNil(aBindSourceAdapter);
end;
Second example that seems to work by typecasting to integers
uses Data.Bind.ObjectScope;
Type
TMyEnumtype = (meOne, meTwo, meThree);
TMyObject = class
public
MyEnumType: integer;
end;
procedure TForm9.But1Click(Sender: TObject);
var
MyObject: TMyObject;
aBindSourceAdapter: TBindSourceAdapter;
aEnumType : TMyEnumtype;
begin
MyObject := TMyObject.Create;
MyObject.MyEnumType := Integer(meTwo);
aBindSourceAdapter := TObjectBindSourceAdapter<TMyObject>.Create(nil, MyObject, False);
if aBindSourceAdapter.FindField('MyEnumType') <> nil then
ShowMessage('MyEnumType found')
else
showmessage('MyEnumType not found');
aEnumType := TMyEnumtype(aBindSourceAdapter.FindField('MyEnumType').GetTValue.AsInteger);
if aEnumType = meTwo then
showmessage('meTwo');
FreeAndNil(MyObject);
FreeAndNil(aBindSourceAdapter);
end;
I was wondering if someone else had come across this problem and if there is perhaps some other solution to solve this without reverting to integers and keep using the enumerated types. I'm also not sure if my workaround is the common way to do this or not.
I believe the best way is to register a converter. It turns out to be very easy, but only after digging through the VCL source code. I didn't find any useful documentation. But here it is.
unit MyConverters;
interface
uses System.Rtti, System.Bindings.Outputs;
type
TMyEnum = (Value1, Value2, Value3);
implementation
procedure RegisterConverters;
begin
TValueRefConverterFactory.RegisterConversion(TypeInfo(TMyEnum), TypeInfo(string),
TConverterDescription.Create(
procedure(const InValue: TValue; var OutValue: TValue)
var
MyEnum: TMyEnum;
S: string;
begin
MyEnum := InValue.AsType<TMyEnum>;
case MyEnum of
Value1: S := 'First Value';
Value2: S := 'Second Value';
Value3: S := 'Third Value';
else S := 'Other';
end;
OutValue := TValue.From<string>(S);
end,
'TMyEnumToString',
'TMyEnumToString',
'', // TODO what is the AUnitName param used for?
True, // TODO what is ADefaultEnabled used for? What does it mean?
'Converts a TMyEnum value to a string',
nil)
);
end;
initialization
RegisterConverters;
end.
In a nutshell, you call TValueRefConverterFactor.RegisterConversion() and pass in:
The type that this converter converts FROM
The type that this converter converts TO
A TConverterDescription that contains an anonymous procedure to actually perform the conversion along with some other metadata.
In the above code, the initialization section calls RegisterConverters, so all that is necessary is to include the unit in your project and the live bindings framework will use the converter whenever it needs to convert a TMyEnum value to a string.
Casting enums as integers and back is really the appropriate way to accommodate for this. Let's say for example...
type
TMyEnum = (meOne, meTwo, meThree);
As you already demonstrate, these can be casted as integers. When casting as an integer, it uses the index in which each one is listed in the definition. So...
0 = meOne
1 = meTwo
2 = meThree
You would cast TMyEnum as Integer like...
Something := Integer(MyEnumValue);
and then cast it back like...
Something := TMyEnum(MyIntegerValue);
This is widely used to solve your exact issue, and I use it all the time myself. I investigated the same scenario long ago and came to the conclusion that it's really the only way to do this - unless you want to do some more sophisticated conversion such as using strings...
function MyEnumToStr(const MyEnum: TMyEnum): String;
begin
case MyEnum of
meOne: Result:= 'meOne';
meTwo: Result:= 'meTwo';
meThree: Result:= 'meThree';
end;
end;
function StrToMyEnum(const Str: String): TMyEnum;
var
S: String;
begin
S:= UpperCase(Str);
if S = 'MEONE' then Result:= meOne
else if S = 'METWO' then Result:= meTwo
else if S = 'METHREE' then Result:= meThree;
end;
(I'm sure there are other ways of using if statements for StrToMyEnum)
Using strings in this manner can make things more readable. A more real-world example...
type
TCustomerType = (cmRetail, cmWholesale, cmDesigner);
where...
cmRetail = 'Retail Customer'
cmWholesale = 'Wholesale Customer'
cmDesigner = 'Designer Customer'
I'd like to set the length of a dynamic array, as suggested in this post. I have two classes TMyClass and the related TChildClass defined as
TChildClass = class
private
FField1: string;
FField2: string;
end;
TMyClass = class
private
FField1: TChildClass;
FField2: Array of TChildClass;
end;
The array augmentation is implemented as
var
RContext: TRttiContext;
RType: TRttiType;
Val: TValue; // Contains the TMyClass instance
RField: TRttiField; // A field in the TMyClass instance
RElementType: TRttiType; // The kind of elements in the dyn array
DynArr: TRttiDynamicArrayType;
Value: TValue; // Holding an instance as referenced by an array element
ArrPointer: Pointer;
ArrValue: TValue;
ArrLength: LongInt;
i: integer;
begin
RContext := TRTTIContext.Create;
try
RType := RContext.GetType(TMyClass.ClassInfo);
Val := RType.GetMethod('Create').Invoke(RType.AsInstance.MetaclassType, []);
RField := RType.GetField('FField2');
if (RField.FieldType is TRttiDynamicArrayType) then begin
DynArr := (RField.FieldType as TRttiDynamicArrayType);
RElementType := DynArr.ElementType;
// Set the new length of the array
ArrValue := RField.GetValue(Val.AsObject);
ArrLength := 3; // Three seems like a nice number
ArrPointer := ArrValue.GetReferenceToRawData;
DynArraySetLength(ArrPointer, ArrValue.TypeInfo, 1, #ArrLength);
{ TODO : Fix 'Index out of bounds' }
WriteLn(ArrValue.IsArray, ' ', ArrValue.GetArrayLength);
if RElementType.IsInstance then begin
for i := 0 to ArrLength - 1 do begin
Value := RElementType.GetMethod('Create').Invoke(RElementType.AsInstance.MetaclassType, []);
ArrValue.SetArrayElement(i, Value);
// This is just a test, so let's clean up immediatly
Value.Free;
end;
end;
end;
ReadLn;
Val.AsObject.Free;
finally
RContext.Free;
end;
end.
Being new to D2010 RTTI, I suspected the error could depend on getting ArrValue from the class instance, but the subsequent WriteLn prints "TRUE", so I've ruled that out. Disappointingly, however, the same WriteLn reports that the size of ArrValue is 0, which is confirmed by the "Index out of bounds"-exception I get when trying to set any of the elements in the array (through ArrValue.SetArrayElement(i, Value);). Do anyone know what I'm doing wrong here? (Or perhaps there is a better way to do this?) TIA!
Dynamic arrays are kind of tricky to work with. They're reference counted, and the following comment inside DynArraySetLength should shed some light on the problem:
// If the heap object isn't shared (ref count = 1), just resize it. Otherwise, we make a copy
Your object is holding one reference to it, and so is the TValue. Also, GetReferenceToRawData gives you a pointer to the array. You need to say PPointer(GetReferenceToRawData)^ to get the actual array to pass to DynArraySetLength.
Once you've got that, you can resize it, but you're left with a copy. Then you have to set it back onto the original array.
TValue.Make(#ArrPointer, dynArr.Handle, ArrValue);
RField.SetValue(val.AsObject, arrValue);
All in all, it's probably a lot simpler to just use a list instead of an array. With D2010 you've got Generics.Collections available, which means you can make a TList<TChildClass> or TObjectList<TChildClass> and have all the benefits of a list class without losing type safety.
I think you should define the array as a separate type:
TMyArray = array of TMyClass;
and use that.
From an old RTTI based XML serializer I know the general method that you use should work (D7..2009 tested):
procedure TXMLImpl.ReadArray(const Name: string; TypeInfo: TArrayInformation; Data: Pointer; IO: TParameterInputOutput);
var
P: PChar;
L, D: Integer;
BT: TTypeInformation;
begin
FArrayType := '';
FArraySize := -1;
ComplexTypePrefix(Name, '');
try
// Get the element type info.
BT := TypeInfo.BaseType;
if not Assigned(BT) then RaiseSerializationReadError; // Not a supported datatype!
// Typecheck the array specifier.
if (FArrayType <> '') and (FArrayType <> GetTypeName(BT)) then RaiseSerializationReadError;
// Do we have a fixed size array or a dynamically sized array?
L := FArraySize;
if L >= 0 then begin
// Set the array
DynArraySetLength(PPointer(Data)^,TypeInfo.TypeInformation,1,#L);
// And restore he elements
D := TypeInfo.ElementSize;
P := PPointer(Data)^;
while L > 0 do begin
ReadElement(''{ArrayItemName},BT,P,IO); // we allow any array item name.
Inc(P,D);
Dec(L);
end;
end else begin
RaiseNotSupported;
end;
finally
ComplexTypePostfix;
end;
end;
Hope this helps..
Hey all, first sorry for my bad english.
Consider the following (not actual code):
IMyInterface = Interface(IInterfce)
procedure Go();
end;
MyClass = class(IMyInterface)
procedure Go();
end;
MyOtherClass = class
published
property name: string;
property data: MyClass;
end;
I'm setting "MyOtherClass" properties using RTTI. For the string property it's easy, but my question is:
How can I get a reference to the "data" (MyClass) property so I can call the Go() method?
I want to do something like this (pseudo-code):
for i:= 0 to class.Properties.Count
if (propertyType is IMyInterface) then
IMyInterface(class.properties[i]).Go()
(if only this was C# :( )
PS.: this is in delphi 7 (i know, even worse)
If the string property is easy, as you say, then I assume you're calling GetStrProp and SetStrProp from the TypInfo unit. Class-type properties can be equally easy with GetObjectProp and SetObjectProp.
if Supports(GetObjectProp(Obj, 'data'), IMyInterface, Intf) then
Intf.Go;
If you don't really need the interface, and you know that the data property has type TMyClass, then you can go a little more directly:
(GetObjectProp(Obj, 'data') as TMyClass).Go;
That requires the property to have a non-null value.
If you don't know the name of the property you want, then you can use some other things in TypInfo to search for it. For example, here is a function that will find all the published properties of an object that have values that implement IMyInterface; it calls Go on each of them in no particular order.
procedure GoAllProperties(Other: TObject);
var
Properties: PPropList;
nProperties: Integer;
Info: PPropInfo;
Obj: TObject;
Intf: IMyInterface;
Unk: IUnknown;
begin
// Get a list of all the object's published properties
nProperties := GetPropList(Other.ClassInfo, Properties);
if nProperties > 0 then try
// Optional: sort the list
SortPropList(Properties, nProperties);
for i := 0 to Pred(nProperties) do begin
Info := Properties^[i];
// Skip write-only properties
if not Assigned(Info.GetProc) then
continue;
// Check what type the property holds
case Info.PropType^^.Kind of
tkClass: begin
// Get the object reference from the property
Obj := GetObjectProp(Other, Info);
// Check whether it implements IMyInterface
if Supports(Obj, IMyInterface, Intf) then
Intf.Go;
end;
tkInterface: begin
// Get the interface reference from the property
Unk := GetInterfaceProp(Obj, Info);
// Check whether it implements IMyInterface
if Supports(Unk, IMyInterface, Intf) then
Intf.Go;
end;
end;
end;
finally
FreeMem(Properties);
end;
end;
You can get an array of all published propertied by calling GetPropInfos(MyClass.ClassInfo). This is an array of PPropInfo pointers. And you can get at type-specific data from a PPropInfo by calling GetTypeData on it, which returns a PTypeData. The record it points to will have the information you're looking for about the class reference.