パート2
パート3. DUnit + FireMonkey 。
パート3.1。 GUIRunnerに基づいています 。
プログラミングへの情熱の始まりでさえ、ファイルを扱うことが好きでした。 ただし、作業は主に入力データの読み取りと結果の記録で構成されていました。 その後、データベースでの作業が行われ、ファイルの使用はどんどん少なくなりました。 場合によっては最大IniFile。 したがって、シリアル化のタスクは私にとって非常に興味深いものでした。
今日は、プログラムにシリアル化を追加した方法、どのような困難が生じ、それらを克服したかについてお話します。 材料はもはや新しいものではないため、初心者にとってはより可能性が高くなります。 しかし、いくつかのトリックはすべてを批判する可能
「連載」の概念そのものが 、彼のブログで gunsmokerによって非常によく述べられていました。
私はJSON形式でのシリアル化に決めました。 なぜJSON 読みやすく（メモ帳++のプラグインを使用しています）、複雑なデータ構造を記述することができます。最後に、Rad Studio XE7には箱からのJSONサポートがあります。
まず、小さなプロトタイプを作成します。そのタスクは特定のオブジェクトを保存することです。
... 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" } }
次の手順では、TmsShape図形のリストをシリアル化します。 これを行うには、「リスト」フィールドを持つ新しいクラスを追加します。
... 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;
保存コードで、コンテナの作成を追加し、それに2つのオブジェクトを追加し、マーシャリングを呼び出すためのパラメーターも変更します（マーシャリングとシリアル化の違いはGunSmokerの記事で説明されています）。
… 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": { } } } } } }
ご覧のとおり、ファイルには余分な情報が多すぎます。 XE7の標準Jsonライブラリでマーシャリングするための処理オブジェクトの実装の機能により、このようになります。 実際には、この8種類の標準コンバーターの標準ライブラリーに記載されています（コンバーター）。
//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;
コンバータの操作の詳細については、 ここで説明します 。
ただし、 ここで書式設定が行われていない翻訳。
簡単に言うと、標準のデータ構造を処理できる8つの関数があります。 ただし、これらの関数を再定義する必要はありません（匿名でもかまいません）。
やってみますか？
… 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.
アプリケーションにシリアル化を追加します。
アプリケーションの外観を読者に思い出させてください：
UMLダイアグラムと同様に：
TmsDiagrammクラスをシリアル化する必要があります。 しかし、すべてではありません。 ダイアグラム上の図のリストとダイアグラムの名前のみが必要です。
... 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; ...
2つの静的関数を持つシリアル化クラスを追加します。
type TmsSerializeController = class(TObject) public class procedure Serialize(const aFileName: string; const aDiagramm: TmsDiagramm); class function DeSerialize(const aFileName: string): TmsDiagramm; end; // TmsDiagrammsController
シリアル化関数は、上記の例と同じです。 しかし、出力のファイルの代わりに、例外が発生しました：
Debagerは、ライブラリ関数の制限に満足しています。
そして、問題は私たちのリストです：
type TmsShapeList = class(TList<ImsShape>) public function ShapeByPt(const aPoint: TPointF): ImsShape; end; // TmsShapeList
これは、Jsonがすぐに「食べない」インターフェースのリストです。 悲しいことに、何かをする必要があります。
リストはインターフェースベースですが、リスト内のオブジェクトは本物なので、オブジェクトのリストをシリアル化するだけですか？
すぐに言ってやった。
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;
一般的な考え方は、リストを調べて各オブジェクトを保存することです。
彼の決定をプロジェクトマネージャーに提示しました。 そして？
一般的に。
「手で」手に入れました。 アマチュア公演用。 そして、彼自身は、現在、デシリアライゼーションが同じ「マニュアル」であることを理解しました。
ふさわしくない。
介入したヘッドは、各オブジェクトにHackInstanceメソッドを追加することを勧めました。このメソッドは、その後、ToObjectという正気な名前を取得します
function TmsShape.HackInstance : TObject; begin Result := Self; end;
オブジェクトで正しく動作するようにシリアル化コントローラーを教えたら、次のモジュールを取得します。
ユニットmsSerializeController;
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.
何を得たのか見てみましょう
Jsonでは、次のようになります。
{ "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" } }
終了する時が来ました。 ただし、以前の投稿では、プロジェクトのテストインフラストラクチャのセットアップ方法について説明しました。 したがって、テストを作成します。 TDDファンは濡れたぼろきれを私に投げつけることができます。 ごめんなさい、達人。 私はただ学んでいます。
テストでは、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.
私に役立つリンク：
www.webdelphi.ru/2011/10/rabota-s-json-v-delphi-2010-xe2/#parsejson
edn.embarcadero.com/article/40882
www.sdn.nl/SDN/Artikelen/tabid/58/view/View/ArticleID/3230/Reading-and-Writing-JSON-with-Delphi.aspx
codereview.stackexchange.com/questions/8850/is-marshalling-converters-reverters-via-polymorphism-realistic
メモ帳++用のJSONビューアプラグイン
上級同僚のアレクサンダーは 、私の記事の開発に踏み出しました。 リポジトリへのリンク 。 リポジトリが開いているため、BitBucketのコードplzにすべてのコメントを残してください。 OpenSourceで試してみたい方は、PMにお問い合わせください。
これは、プロジェクト図が今どのように見えるかです：
テストチャート：
