По мотивам - Generic'и в Delphi и шаблоны в C++. Коротко. Напишу грубость
Вот написалась такая чушь:
Вот написалась такая чушь:
unit msMarshal; interface uses JSON, msDiagramm, Data.DBXJSONReflect, msSerializeInterfaces ; type TmsMarshal<TClassToSerialize : class> = class // - шаблонизируем, ибо мы скоро будем сериализовать и другие классы. strict private class var f_Marshal : TJSONMarshal; class var f_UnMarshal : TJSONUnMarshal; class function Marshal: TJSONMarshal; class function UnMarshal: TJSONUnMarshal; public class procedure Serialize(const aFileName: string; const aDiagramm: TClassToSerialize); class procedure DeSerialize(const aFileName: string; const aDiagramm: TClassToSerialize); class destructor Destroy; end;//TmsMarshal TmsDiagrammMarshal = class(TmsMarshall<TmsDiagramm>) end;//TmsDiagrammMarshal implementation uses System.Classes, msShape, FMX.Dialogs, System.SysUtils, msRegisteredShapes, msCoreObjects ; { TmsSerializeController } class function TmsMarshall<TClassToSerialize>.UnMarshal: TJSONUnMarshal; begin if (f_UnMarshal = nil) then begin f_UnMarshal := TJSONUnMarshal.Create; f_UnMarshal.RegisterReverter(TmsDiagramm, 'FShapeList', procedure (Data: TObject; Field: String; Args: TListOfObjects) var l_Object: TObject; l_Diagramm : TmsDiagramm; l_msShape: TmsShape; begin Assert(Data Is TmsDiagramm); l_Diagramm := TmsDiagramm(Data); assert(l_Diagramm l<> nil); for l_Object in Args do begin l_msShape := l_Object as TmsShape; l_Diagramm.ShapeList.Add(l_msShape); end//for l_Object end );//f_UnMarshal.RegisterReverter end;//f_UnMarshal = nil Result := f_UnMarshal; end; class destructor TmsMarshall<TClassToSerialize>.Destroy; begin FreeAndNil(f_Marshal); FreeAndNil(f_UnMarshal); end; class function TmsMarshall<TClassToSerialize>.Marshal: TJSONMarshal; begin if (f_Marshal = nil) then begin f_Marshal := TJSONMarshal.Create; f_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 As ImsObjectWrap).HackInstance; Inc(l_Index); end; // for l_Shape end );//f_Marshal.RegisterConverter TmsRegisteredShapes.IterateShapes( procedure (aShapeClass: RmsShape) begin f_Marshal.RegisterJSONMarshalled(aShapeClass, 'FRefCount', false); end );//TmsRegisteredShapes.IterateShapes end;//f_Marshal = nil Result := f_Marshal; end; class procedure TmsMarshall<TClassToSerialize>.DeSerialize(const aFileName: string; const aDiagramm: TClassToSerialize); var l_StringList: TmsStringList; l_D : TObject; begin l_StringList := TmsStringList.Create; try l_StringList.LoadFromFile(aFileName); l_D := UnMarshal.Unmarshal(TJSONObject.ParseJSONValue(l_StringList.Text)); try if (aDiagramm Is TmsDiagramm) then (aDiagramm As TmsDiagramm).Assign(l_D As TmsDiagramm) else Assert(false); finally FreeAndNil(l_D); end;//try..finally finally FreeAndNil(l_StringList); end;//try..finally end; class procedure TmsMarshall<TClassToSerialize>.Serialize(const aFileName: string; const aDiagramm: TClassToSerialize); var l_Json: TJSONObject; l_StringList: TmsStringList; begin l_StringList := TmsStringList.Create; try l_Json := nil; try try l_Json := Marshal.Marshal(aDiagramm) as TJSONObject; except on E: Exception do ShowMessage(E.ClassName + ' поднята ошибка, с сообщением : ' + E.Message); end;//try..except l_StringList.Add(l_Json.toString); finally FreeAndNil(l_Json); end;//try..finally l_StringList.SaveToFile(aFileName); finally FreeAndNil(l_StringList); end;//try..finally end; end.Позже я напишу как эту чушь сделать не чушью.
Комментариев нет:
Отправить комментарий