mac donald
asked on
Export/import TDummy (TControl3D) as a file
Hello,
I need a function writed in Firemonkey (Delphi XE 10.2) to export a TDummy as a file (from a Viewport3D), and import this file back as original exported TDummy.
The TDummy contain various number of childrens like other TDummy, TCube... etc.
The exported/imported file should include all childrens from original TDummy.
Can someone write this function for me and how much it will cost ?
Thank you
Mac
I need a function writed in Firemonkey (Delphi XE 10.2) to export a TDummy as a file (from a Viewport3D), and import this file back as original exported TDummy.
The TDummy contain various number of childrens like other TDummy, TCube... etc.
The exported/imported file should include all childrens from original TDummy.
Can someone write this function for me and how much it will cost ?
Thank you
Mac
ASKER
It's exactly what i need...
Many Thank's
Many Thank's
I made simple example .... with own enumerating and saving properties into ini file....If someone needs it. (Delphi 10.2.)
... example enumerate properties and store them to ini file. This is only proof of concept... Loading is a reverse logic....
uses ... Rtti, IniFiles, System.TypInfo;
...
procedure EnumObjPropsToIni(rtti_ctx : TRttiContext; Ini: TIniFile; sSectionName: String; objIn: TObject);
implementation
function GetValueStr(rtti_ctx : TRttiContext; Ini: TIniFile; sSectionName: String;
rttiType: TRttiType; var aValue: TValue) : string;
begin
Result := '';
case aValue.Kind of
tkWChar, tkLString, tkWString, tkString, tkChar, tkUString,
tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet:
begin
Result := aValue.ToString;
end;
tkClass:
begin
if aValue.IsObject then
begin
if aValue.AsObject <> nil then
begin
if (aValue.AsObject is TFmxObject) then //get object name
Result := TFmxObject(aValue.AsObject).Name
else // expand class props...
begin
EnumObjPropsToIni(rtti_ctx, Ini, sSectionName, aValue.AsObject);
Result := '['+sSectionName+']';
end;
end;
end;
end;
tkMethod, tkVariant, tkArray, tkRecord, tkInterface, tkDynArray,
tkClassRef, tkPointer, tkProcedure:
begin
//Result := IntTostr(Integer(aValue.Kind));
//TODO...
end;
end;
end;
procedure EnumObjPropsToIni(rtti_ctx : TRttiContext; Ini: TIniFile; sSectionName: String; objIn: TObject);
var
objType: TRttiType;
rtti_Prop: TRttiProperty;
Value, Value_Def: TValue;
Data, Data_Def: String;
ObjClass: TClass;
TestObj: TObject;
RttiType: TRttiInstanceType;
begin
ObjClass := objIn.ClassType;
TestObj := nil;
objType := rtti_ctx.GetType(ObjClass);
if Assigned(objType) then
begin
if objIn is TFmxObject then
begin
RttiType := rtti_ctx.GetType(ObjClass) as TRttiInstanceType;
//create default instance - for comparing purpose ... I don't want to use all props...only modified
TestObj := RttiType.GetMethod('Create').Invoke(RttiType.MetaclassType,
[(objIn as TFMXObject).Parent.Owner]).AsObject;
end;
try
for rtti_Prop in objType.GetProperties do
begin
if not rtti_Prop.IsWritable then continue;
if not rtti_Prop.IsReadable then continue;
if (rtti_Prop.Visibility <> mvPublished) then continue;
//prp values from object
Value := rtti_Prop.GetValue(objIn);
Data := GetValueStr(rtti_ctx, Ini, sSectionName+'.'+rtti_Prop.Name, objType, Value);
//prp values for default
if Assigned(TestObj) then
begin
Value_Def := rtti_Prop.GetValue(TestObj);
Data_Def := GetValueStr(rtti_ctx, Ini, sSectionName+'.'+rtti_Prop.Name, RttiType, Value_Def);
end
else
begin
Data_Def := '';
end;
//if property value different than newly created...
if Data_Def <> Data then
Ini.WriteString(sSectionName, rtti_Prop.Name, Data);
end;
for rtti_Prop in objType.GetDeclaredProperties do
begin
if not rtti_Prop.IsWritable then continue;
if not rtti_Prop.IsReadable then continue;
if (rtti_Prop.Visibility <> mvPublished) then continue;
//prp values from object
Value := rtti_Prop.GetValue(objIn);
Data := GetValueStr(rtti_ctx, Ini, sSectionName+'.'+rtti_Prop.Name, objType, Value);
//prp values for default
if Assigned(TestObj) then
begin
Value_Def := rtti_Prop.GetValue(TestObj);
Data_Def := GetValueStr(rtti_ctx, Ini, sSectionName+'.'+rtti_Prop.Name, RttiType, Value_Def);
end
else
begin
Data_Def := '';
end;
//if property value different than newly created...
if Data_Def <> Data then
Ini.WriteString(sSectionName, rtti_Prop.Name, Data);
end;
finally
TestObj.Free;
end;
end;
end;
procedure ExportObjectToIni(rtti_ctx : TRttiContext; Ini: TIniFile; sSectionName: String; objIn: TObject);
var
i: integer;
Obj: TFMXObject;
sObjName: String;
begin
if objIn is TFMXObject then
begin
Obj := TFMXObject(objIn);
//iterate all child components
for i := 1 to Obj.ChildrenCount do
begin
//us only main object
if Obj.Children[i-1].Name <> '' then
begin
sObjName := sSectionName+'.'+Obj.Children[i-1].Name;
//enumerate properties...
EnumObjPropsToIni(rtti_ctx, Ini, sObjName, Obj.Children[i-1]);
//export sub-child too...
ExportObjectToIni(rtti_ctx, Ini, sObjName, Obj.Children[i-1]);
end;
end;
end;
end;
procedure SaveObjectsToIni(FileName: String; obj: TFmxObject);
var
rtti_ctx : TRttiContext;
Ini : TIniFile;
sSectionName: String;
begin
rtti_ctx := TRttiContext.Create;
try
Ini := TIniFile.Create(FileName);
try
sSectionName := Obj.Name;
ExportObjectToIni(rtti_ctx, Ini, sSectionName, Obj);
finally
Ini.Free;
end;
finally
rtti_ctx.Free;
end;
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
SaveObjectsToIni('C:\Temp\test.ini', Viewport3D1);
end;
... example enumerate properties and store them to ini file. This is only proof of concept... Loading is a reverse logic....
ASKER
It's a good solution,
Many thank's
Many thank's
This question needs an answer!
Become an EE member today
7 DAY FREE TRIALMembers can start a 7-Day Free trial then enjoy unlimited access to the platform.
View membership options
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
I