... type TmsShape = class private fInt: integer; fStr: String; public constructor Create(const aInt: integer; const aStr: String); end; constructor TmsShape.Create(const aInt: integer; const aStr: String); begin inherited fInt := aInt; fStr := aStr; end; procedure TForm2.btSaveJsonClick(Sender: TObject); var l_Marshal: TJSONMarshal; l_Json: TJSONObject; l_Shape1: TmsShape; l_StringList: TStringList; begin try l_Shape1 := TmsShape.Create(1, 'First'); l_Marshal := TJSONMarshal.Create; l_StringList := TStringList.Create; l_Json := l_Marshal.Marshal(l_Shape1) as TJSONObject; Memo1.Lines.Text := l_Json.tostring; l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(_FileNameSave); finally FreeAndNil(l_Marshal); FreeAndNil(l_StringList); FreeAndNil(l_Json); FreeAndNil(l_Shape1); end; end;
{ "type": "uMain.TmsShape", "id": 1, "fields": { "fInt": 1, "fStr": "First" } }
... type TmsShapeContainer = class private fList: TList<TmsShape>; public constructor Create; destructor Destroy; end; constructor TmsShapeContainer.Create; begin inherited; fList := TList<TmsShape>.Create; end; destructor TmsShapeContainer.Destroy; begin FreeAndNil(fList); inherited; end;
… l_msShapeContainer := TmsShapeContainer.Create; l_msShapeContainer.fList.Add(l_Shape1); l_msShapeContainer.fList.Add(l_Shape2); … l_Json := l_Marshal.Marshal(l_msShapeContainer) as TJSONObject; ...
{ "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": { "type": "System.Generics.Collections.TList<uMain.TmsShape>", "id": 2, "fields": { "FItems": [{ "type": "uMain.TmsShape", "id": 3, "fields": { "fInt": 1, "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 4, "fields": { "fInt": 2, "fStr": "Second" } }], "FCount": 2, "FArrayManager": { "type": "System.Generics.Collections.TMoveArrayManager<uMain.TmsShape>", "id": 5, "fields": { } } } } } }
//Convert a field in an object array TObjectsConverter = reference to function(Data: TObject; Field: String): TListOfObjects; //Convert a field in a strings array TStringsConverter = reference to function(Data: TObject; Field: string): TListOfStrings; //Convert a type in an objects array TTypeObjectsConverter = reference to function(Data: TObject): TListOfObjects; //Convert a type in a strings array TTypeStringsConverter = reference to function(Data: TObject): TListOfStrings; //Convert a field in an object TObjectConverter = reference to function(Data: TObject; Field: String): TObject; //Convert a field in a string TStringConverter = reference to function(Data: TObject; Field: string): string; //Convert specified type in an object TTypeObjectConverter = reference to function(Data: TObject): TObject; //Convert specified type in a string TTypeStringConverter = reference to function(Data: TObject): string;
… l_Marshal.RegisterConverter(TmsShapeContainer, 'fList', function(Data: TObject; Field: string): TListOfObjects var l_Shape : TmsShape; l_Index: integer; begin SetLength(Result, (Data As TmsShapeContainer).fList.Count); l_Index := 0; for l_Shape in (Data As TmsShapeContainer).fList do begin Result[l_Index] := l_Shape; Inc(l_Index); end; end ); ...
{ "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": [{ "type": "uMain.TmsShape", "id": 2, "fields": { "fInt": 1, "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 3, "fields": { "fInt": 2, "fStr": "Second" } }] } }
type TmsShape = class private [JSONMarshalled(False)] fInt: integer; [JSONMarshalled(True)] fStr: String; public constructor Create(const aInt: integer; const aStr: String); end;
{ "type": "uMain.TmsShapeContainer", "id": 1, "fields": { "fList": [{ "type": "uMain.TmsShape", "id": 2, "fields": { "fStr": "First" } }, { "type": "uMain.TmsShape", "id": 3, "fields": { "fStr": "Second" } }] } }
unit uMain; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Layouts, FMX.Memo, Generics.Collections, Data.DBXJSONReflect ; type TForm2 = class(TForm) SaveDialog1: TSaveDialog; Memo1: TMemo; btSaveJson: TButton; btSaveEMB_Example: TButton; procedure btSaveJsonClick(Sender: TObject); procedure btSaveEMB_ExampleClick(Sender: TObject); private { Private declarations } public { Public declarations } end; type TmsShape = class private [JSONMarshalled(False)] fInt: integer; [JSONMarshalled(True)] fStr: String; public constructor Create(const aInt: integer; const aStr: String); end; TmsShapeContainer = class private fList: TList<TmsShape>; public constructor Create; destructor Destroy; end; var Form2: TForm2; implementation uses json, uFromEmbarcadero; const _FileNameSave = 'D:\TestingJson.ms'; {$R *.fmx} { TmsShape } constructor TmsShape.Create(const aInt: integer; const aStr: String); begin fInt := aInt; fStr := aStr; end; procedure TForm2.btSaveEMB_ExampleClick(Sender: TObject); begin Memo1.Lines.Assign(mainproc); end; procedure TForm2.btSaveJsonClick(Sender: TObject); var l_Marshal: TJSONMarshal; l_Json: TJSONObject; l_Shape1, l_Shape2: TmsShape; l_msShapeContainer: TmsShapeContainer; l_StringList: TStringList; begin try l_Shape1 := TmsShape.Create(1, 'First'); l_Shape2 := TmsShape.Create(2, 'Second'); l_msShapeContainer := TmsShapeContainer.Create; l_msShapeContainer.fList.Add(l_Shape1); l_msShapeContainer.fList.Add(l_Shape2); l_Marshal := TJSONMarshal.Create; l_StringList := TStringList.Create; l_Marshal.RegisterConverter(TmsShapeContainer, 'fList', function(Data: TObject; Field: string): TListOfObjects var l_Shape : TmsShape; l_Index: integer; begin SetLength(Result, (Data As TmsShapeContainer).fList.Count); l_Index := 0; for l_Shape in (Data As TmsShapeContainer).fList do begin Result[l_Index] := l_Shape; Inc(l_Index); end; end ); l_Json := l_Marshal.Marshal(l_msShapeContainer) as TJSONObject; Memo1.Lines.Text := l_Json.tostring; l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(_FileNameSave); finally FreeAndNil(l_Marshal); FreeAndNil(l_StringList); FreeAndNil(l_Json); FreeAndNil(l_Shape1); FreeAndNil(l_Shape2); FreeAndNil(l_msShapeContainer); end; end; { TmsShapeContainer } constructor TmsShapeContainer.Create; begin inherited; fList := TList<TmsShape>.Create; end; destructor TmsShapeContainer.Destroy; begin FreeAndNil(fList); inherited; end; end.
... type TmsShapeList = class(TList<ImsShape>) public function ShapeByPt(const aPoint: TPointF): ImsShape; end; // TmsShapeList TmsDiagramm = class(TmsInterfacedNonRefcounted, ImsShapeByPt, ImsShapesController, IInvokable) private [JSONMarshalled(True)] FShapeList: TmsShapeList; [JSONMarshalled(False)] FCurrentClass: RmsShape; [JSONMarshalled(False)] FCurrentAddedShape: ImsShape; [JSONMarshalled(False)] FMovingShape: TmsShape; [JSONMarshalled(False)] FCanvas: TCanvas; [JSONMarshalled(False)] FOrigin: TPointF; f_Name: String; ...
type TmsSerializeController = class(TObject) public class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); class function DeSerialize(const aFileName: string): TmsDiagramm; end; // TmsDiagrammsController
type TmsShapeList = class(TList<ImsShape>) public function ShapeByPt(const aPoint: TPointF): ImsShape; end; // TmsShapeList
var l_SaveDialog: TSaveDialog; l_Marshal: TJSONMarshal; // Serializer l_Json: TJSONObject; l_JsonArray: TJSONArray; l_StringList: TStringList; l_msShape: ImsShape; begin l_SaveDialog := TSaveDialog.Create(nil); if l_SaveDialog.Execute then begin try l_Marshal := TJSONMarshal.Create; l_StringList := TStringList.Create; l_JsonArray := TJSONArray.Create; for l_msShape in FShapeList do begin l_Json := l_Marshal.Marshal(TObject(l_msShape)) as TJSONObject; l_JsonArray.Add(l_Json); end; l_Json := TJSONObject.Create(TJSONPair.Create('MindStream', l_JsonArray)); l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(l_SaveDialog.FileName); finally FreeAndNil(l_Json); FreeAndNil(l_StringList); FreeAndNil(l_Marshal); end; end else assert(false); FreeAndNil(l_SaveDialog); end;
function TmsShape.HackInstance : TObject; begin Result := Self; end;
unit msSerializeController; interface uses JSON, msDiagramm, Data.DBXJSONReflect; type TmsSerializeController = class(TObject) public class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); class function DeSerialize(const aFileName: string): TmsDiagramm; end; // TmsDiagrammsController implementation uses System.Classes, msShape, FMX.Dialogs, System.SysUtils; { TmsSerializeController } class function TmsSerializeController.DeSerialize(const aFileName: string) : TmsDiagramm; var l_UnMarshal: TJSONUnMarshal; l_StringList: TStringList; begin try l_UnMarshal := TJSONUnMarshal.Create; l_UnMarshal.RegisterReverter(TmsDiagramm, 'FShapeList', procedure(Data: TObject; Field: String; Args: TListOfObjects) var l_Object: TObject; l_Diagramm: TmsDiagramm; l_msShape: TmsShape; begin l_Diagramm := TmsDiagramm(Data); l_Diagramm.ShapeList := TmsShapeList.Create; assert(l_Diagramm <> nil); for l_Object in Args do begin l_msShape := l_Object as TmsShape; l_Diagramm.ShapeList.Add(l_msShape); end end); l_StringList := TStringList.Create; l_StringList.LoadFromFile(aFileName); Result := l_UnMarshal.Unmarshal (TJSONObject.ParseJSONValue(l_StringList.Text)) as TmsDiagramm; finally FreeAndNil(l_UnMarshal); FreeAndNil(l_StringList); end; end; class procedure TmsSerializeController.Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); var l_Marshal: TJSONMarshal; // Serializer l_Json: TJSONObject; l_StringList: TStringList; begin try l_Marshal := TJSONMarshal.Create; l_Marshal.RegisterConverter(TmsDiagramm, 'FShapeList', function(Data: TObject; Field: string): TListOfObjects var l_Shape: ImsShape; l_Index: Integer; begin assert(Field = 'FShapeList'); SetLength(Result, (Data As TmsDiagramm).ShapeList.Count); l_Index := 0; for l_Shape in (Data As TmsDiagramm).ShapeList do begin Result[l_Index] := l_Shape.HackInstance; Inc(l_Index); end; // for l_Shape end); l_StringList := TStringList.Create; try l_Json := l_Marshal.Marshal(aDiagramm) as TJSONObject; except on E: Exception do ShowMessage(E.ClassName + ' : ' + E.Message); end; l_StringList.Add(l_Json.tostring); l_StringList.SaveToFile(aFileName); finally FreeAndNil(l_Json); FreeAndNil(l_StringList); FreeAndNil(l_Marshal); end; end; end.
{ "type": "msDiagramm.TmsDiagramm", "id": 1, "fields": { "FShapeList": [{ "type": "msCircle.TmsCircle", "id": 2, "fields": { "FStartPoint": [[146, 250], 146, 250], "FRefCount": 1 } }, { "type": "msCircle.TmsCircle", "id": 3, "fields": { "FStartPoint": [[75, 252], 75, 252], "FRefCount": 1 } }, { "type": "msRoundedRectangle.TmsRoundedRectangle", "id": 4, "fields": { "FStartPoint": [[82, 299], 82, 299], "FRefCount": 1 } }, { "type": "msRoundedRectangle.TmsRoundedRectangle", "id": 5, "fields": { "FStartPoint": [[215, 225], 215, 225], "FRefCount": 1 } }, { "type": "msRoundedRectangle.TmsRoundedRectangle", "id": 6, "fields": { "FStartPoint": [[322, 181], 322, 181], "FRefCount": 1 } }, { "type": "msUseCaseLikeEllipse.TmsUseCaseLikeEllipse", "id": 7, "fields": { "FStartPoint": [[259, 185], 259, 185], "FRefCount": 1 } }, { "type": "msTriangle.TmsTriangle", "id": 8, "fields": { "FStartPoint": [[364, 126], 364, 126], "FRefCount": 1 } }], "fName": " â„–1" } }
unit TestmsSerializeController; { Delphi DUnit Test Case ---------------------- This unit contains a skeleton test case class generated by the Test Case Wizard. Modify the generated code to correctly setup and call the methods from the unit being tested. } interface uses TestFramework, msSerializeController, Data.DBXJSONReflect, JSON, FMX.Objects, msDiagramm ; type // Test methods for class TmsSerializeController TestTmsSerializeController = class(TTestCase) strict private FmsDiagramm: TmsDiagramm; FImage: TImage; public procedure SetUp; override; procedure TearDown; override; published procedure TestSerialize; procedure TestDeSerialize; end; implementation uses System.SysUtils, msTriangle, msShape, System.Types, System.Classes ; const c_DiagramName = 'First Diagram'; c_FileNameTest = 'SerializeTest.json'; c_FileNameEtalon = 'SerializeEtalon.json'; procedure TestTmsSerializeController.SetUp; begin FImage:= TImage.Create(nil); FmsDiagramm := TmsDiagramm.Create(FImage, c_DiagramName); end; procedure TestTmsSerializeController.TearDown; begin FreeAndNil(FImage); FreeAndNil(FmsDiagramm); end; procedure TestTmsSerializeController.TestSerialize; var l_FileSerialized, l_FileEtalon: TStringList; begin FmsDiagramm.ShapeList.Add(TmsTriangle.Create(TmsMakeShapeContext.Create(TPointF.Create(10, 10),nil))); // TODO: Setup method call parameters TmsSerializeController.Serialize(c_FileNameTest, FmsDiagramm); // TODO: Validate method results l_FileSerialized := TStringList.Create; l_FileSerialized.LoadFromFile(c_FileNameTest); l_FileEtalon := TStringList.Create; l_FileEtalon.LoadFromFile(c_FileNameEtalon); CheckTrue(l_FileEtalon.Equals(l_FileSerialized)); FreeAndNil(l_FileSerialized); FreeAndNil(l_FileEtalon); end; procedure TestTmsSerializeController.TestDeSerialize; var ReturnValue: TmsDiagramm; aFileName: string; begin // TODO: Setup method call parameters ReturnValue := TmsSerializeController.DeSerialize(aFileName); // TODO: Validate method results end; initialization // Register any test cases with the test runner RegisterTest(TestTmsSerializeController.Suite); end.
Source: https://habr.com/ru/post/245441/
All Articles