レコードデータをリスト化する

レコードデータをJSON形式で読み書きできたら
あとはリスト化して管理することになります。

リスト化するという事で通常はTListを使うところですが、
今回はTDictionaryを使ってみようかと思います。

　
ジェネリックス関数を利用することになるので Uses節に

System.Generics.Defaults,System.Generics.Collections

が必要になります。後々のために Rtti も追加しておくと幸せになれます。

　
さて、
　

基本的な考え方として、それぞれのリスト項目にIDを振り、
項目にアクセスするためには、そのIDを通じて行う。

とします。そのリスト格納部分にTDictionaryを使用します。

　
すべてのレコード形式に対応するようにジェネリックス関数を利用するわけですが、
その準備段階としてレコード形式に関係しないベースとなるクラスを作成します。

とりあえずソースを。これは今使っている簡易的な物です。

コピペなのでこのままでは動かないかもしれませんが、
雰囲気を感じ取ってください。

ゆくゆくは整備していきたいと思いますが、今はとりあえずこれで。

（宣言部）
 TNYBaseList=class

  private
   FModified:boolean;

   FVST:TVirtualStringTree;

   //---------------------------
   // Property Access Method
   //---------------------------
   function FGetCount:integer;  virtual; abstract;

  protected
   //------------------------------------------
   // 表示用リスト
   //------------------------------------------
   FDispList:TList;     //表示されているリストのIDを列挙

  public
   constructor Create;
   destructor  Destroy;override;

   //File IO
   function  SaveRecordToJSON:string;          virtual; abstract;
   procedure LoadRecordFromJSON(val:string);   virtual; abstract;

   //Filter
   procedure Filter;                           virtual; abstract;
   procedure FilterEx(idx:integer;val:TValue); virtual; abstract;

   //Sort
   //procedure Sort;

  property DispIDs:TList read FDispList;

  //Modified
  property Modified:boolean read FModified;

  //Count
  property Count:integer    read FGetCount;

  //フィルタリング用のVst
  property VST:TVirtualStringTree read FVST write FVST;

 end;


（実装部）
constructor TNYBaseList.Create;
begin
 FDispList:=TList.Create;
 FModified:=False;
end

destructor TNYBaseList.Destroy;
begin
 FreeAndNil(FDispList);

 inherited;
end;

で、実際の格納クラスはこちら。

（宣言部）

const
 _SetNewRecordID  =-1;
 _MaintainRecordID=-2;


 //---------------------------------------------------------------------
 // 具体的なレコードを格納するクラス
 //---------------------------------------------------------------------
 // ※イベントはレコードサイドで実装する
 //   このクラスではイベントとして接続する
 //---------------------------------------------------------------------
 // ■ イベント設定例
 // with StyleContainer do begin
 //  StyleList:=Lists[AddList];
 //  with StyleList do begin
 //   OnGetRecordID :=TNYFormStyleRec.GetID;
 //   OnSetRecordID :=TNYFormStyleRec.SetID;
 //   OnSaveToJson  :=TNYFormStyleRec.SaveToJson;
 //   OnLoadFromJson:=TNYFormStyleRec.LoadFromJson;
 //  end;
 // end;
 //
 // あるいは レコード側で
 // class procedure TNY_XXXXRec.SetEvent(List:TNYRecList);
 // begin
 //  with List do begin
 //   OnGetRecordID :=GetID;
 //   OnSetRecordID :=SetID;
 //   OnSaveToJson  :=SaveToJson;
 //   OnLoadFromJson:=LoadFromJson;
 //  end;
 // end;
 // みたいな感じでもいいかも
 //
 //---------------------------------------------------------------------
 TNYRecList=Class(TNYBaseList)

  type
   TNYGetRecID= reference to function(Val:T):integer;
   TNYSetRecID= reference to function(Val:T;ID:integer):T;
   TNYToJSon  = reference to function(Serializer:TJsonSerializer;Val:T):string;
   TNYFromJSon= reference to function(Val:string;Serializer:TJsonSerializer):T;

   TNYRecFilterEV=reference to function (Sender:TObject;RecData:T;Mode:integer;Val:TValue):boolean;


  private
   //-------------------------
   // データ格納領域
   //-------------------------
   FDic:TDictionary;     // ID=Val

   FFilterVal:TValue;
   FFilterIdx:integer;

   //-------------------------
   // DataStoker Pointer
   //-------------------------
   FCategoryTree:TNY_ExCategoryVST;

   //-------------------------
   // EventHandler Pointer
   //-------------------------
   FOnGetRecordID :TNYGetRecID;
   FOnSetRecordID :TNYSetRecID;
   FOnSaveToJson  :TNYToJSon;
   FOnLoadFromJson:TNYFromJSon;

   FOnFilter      :TNYRecFilterEV;

   function  FGetCount:integer;                    override;
   function  FGetRecord(ID:integer):T;
   function  FGetRecFromIndex(index:integer):T;

   procedure FSetIndexList;       //フィルタ用 あとでPublicに

  public
   constructor Create;
   destructor  Destroy;override;

   function  GetNewID:integer;

   //RecordAccess
   procedure Clear;
   function  SetRecord(Id:integer;Val:T;EV:TNYSetRecID=nil;Ev2:TNYGetRecID=nil):integer;
   procedure DeleteRecord(ID:integer);

   //File IO
   function  SaveRecordToJSON:string;            override;
   procedure LoadRecordFromJSON(Val:string);     override;

   //Filter
   procedure Filter;                            override;
   procedure FilterEx(idx:integer;val:TValue);  override;

  //-----------------
  // 基本プロパティ
  //-----------------
  // 【ID指定】によるレコード取得
  property Records[ID:integer]:T             read FGetRecord;   default;

  // 【インデックス指定】によるレコード取得
  property RecFromIndex[index:integer]:T     read FGetRecFromIndex;

  // データ本体へのアクセス
  property Dictionary:TDictionary read FDic;


  //-------------------------
  // DataStoker Property
  //-------------------------
  property CategoryTree:TNY_ExCategoryVST read FCategoryTree write FCategoryTree;

  property FilterVal:TValue  read FFilterVal write FFilterVal;
  property FilterIdx:integer read FFilterIdx write FFilterIdx;

  //-----------------
  // EventProperty
  //-----------------
  property OnGetRecordID :TNYGetRecID read FOnGetRecordID  write FOnGetRecordID;
  property OnSetRecordID :TNYSetRecID read FOnSetRecordID  write FOnSetRecordID;
  property OnSaveToJson  :TNYToJSon   read FOnSaveToJson   write FOnSaveToJson;
  property OnLoadFromJson:TNYFromJSon read FOnLoadFromJson write FOnLoadFromJson;

  property OnFilter      :TNYRecFilterEV read FOnFilter    write FOnFilter;

 end;


（実装部）
constructor TNYRecList.Create;
begin
 inherited;

 FDic:=TDictionary.Create;
end;


destructor TNYRecList.Destroy;
begin
 //--------------------------------------
 // Tはレコードなので開放の必要がない
 //--------------------------------------
 FreeAndNil(FDic);

 inherited;
end;



//------------------------------------------------------------------------
procedure TNYRecList.Clear;
begin
 FDic.Clear;
 FModified:=False;
end;

function TNYRecList.GetNewID:integer;
var id:integer;
begin
 Result:=1;
 for id in FDic.Keys do begin
  if id>=Result then Result:=id+1;
 end;

end;



function TNYRecList.FGetRecord(ID:integer):T;
var BL:boolean;
begin
 //要修正：ID不存在の際の戻り値が不定のため

 //OK//BL:=(ID<0)or(ID>FList.Count-1);
 if not NP_DispErrMes('ID Not Exists.',FDic.ContainsKey(ID)) then exit;

 Result:=FDic[ID];
end;

function TNYRecList.FGetRecFromIndex(index:integer):T;
begin
 Result:=FDic[FDispList[Index]];
end;


function TNYRecList.FGetCount:integer;
begin
 Result:=FDic.Count;
end;

procedure TNYRecList.FSetIndexList;
var id:integer;
begin
 FDispList.Clear;
 for id in FDic.Keys do FDispList.Add(id);

 FDispList.Sort;


end;

procedure TNYRecList.DeleteRecord(ID:integer);
var idx:integer;
begin
 if not FDic.ContainsKey(ID) then exit;

 FDic.Remove(ID);

 //filter
 FSetIndexList;    //// 要修正

 //ModifiedSet
 FModified:=True;
end;


function TNYRecList.SetRecord(Id:integer;Val:T;EV:TNYSetRecID=nil;Ev2:TNYGetRecID=nil):integer;
var idx,aID:integer;
begin
 (*-----------------------------------------------------------------
  //EVの具体的な内容 : コピーでOK
  class function GetID(Val:TNYFormStyleRec):integer;   static;
  class function SetID(Val:TNYFormStyleRec;ID:integer):TNYFormStyleRec; static;

  class function TNYFormStyleRec.GetID(Val:TNYFormStyleRec):integer;
  begin
   Result:=Val.ID;
  end;

  class function TNYFormStyleRec.SetID(Val:TNYFormStyleRec;ID:integer):TNYFormStyleRec;
  begin
   Result:=Val;
   Result.ID:=ID;
  end;
 -----------------------------------------------------------------*)

 if not Assigned(EV) then EV:=FOnSetRecordID;
 if not NP_DispErrMes('イベントが設定されていません(OnSetRecordID)',Assigned(EV)) then exit;

 if not Assigned(EV2) then EV2:=FOnGetRecordID;
 if not NP_DispErrMes('イベントが設定されていません(OnGetRecordID)',Assigned(EV2)) then exit;


 //-------------
 // 戻り値はID
 //-------------
 case id of
  _MaintainRecordID :Result:=EV2(Val);    //ID変更せず(TのIDを取得)
  _SetNewRecordID..0:Result:=GetNewID;    //新規ID設定 (基礎クラスのIDリスト追加)
  else begin
   //-------------------------------------
   // IDを指定する場合
   // ⇒ 同一レコードの書き換えが前提
   // ⇒ IDの変更は想定外
   //-------------------------------------
   //指定IDを戻り値に設定
   Result:=ID;
 end;
end;


 //--------------------------------------------------------
 // レコードのフィールド「ID」を設定するイベント
 // Result ← IDが入ってきている
 //--------------------------------------------------------
 if id<>_MaintainRecordID then Val:=EV(Val,Result);


 //--------------------------------------------------------------------
 // 追加 OR 上書き
 //--------------------------------------------------------------------
 FDic.AddOrSetValue(Result,Val);

 //filter
 FSetIndexList;    //// 要修正

 //Modified設定
 FModified:=True;
end;


function TNYRecList.SaveRecordToJSON:string;
var i:integer;
    serializer: TJsonSerializer;
begin
 (*-----------------------------------------------------------------
  //EVの具体的な内容 : コピーでOK
  class function SaveToJson(serializer:TJsonSerializer;Rt:TNYFormStyleRec):string; static;

  class function TNYFormStyleRec.SaveToJson(serializer:TJsonSerializer;Rt:TNYFormStyleRec):string;
  begin
   Result:=serializer.Serialize(Rt);
  end;
 -----------------------------------------------------------------*)
 Result:='';

 //if not Assigned(EV) then EV:=FOnSaveToJson;
 if not NP_DispErrMes('イベントが設定されていません(OnSaveToJson)',Assigned(FOnSaveToJson)) then exit;

 serializer := TJsonSerializer.Create;
 try for i in FDic.Keys do Result:=Result+FOnSaveToJson(serializer,FDic[i])+_CRLF;
     FModified:=False;
 finally FreeAndNil(serializer);

 end;

end;


procedure TNYRecList.LoadRecordFromJSON(Val:string);
var i:integer;
    s:string;
    serializer: TJsonSerializer;
begin
 (*-----------------------------------------------------------------
  //EVの具体的な内容 : コピーでOK
  class function LoadFromJson(Val:string;serializer:TJsonSerializer):TNYFormStyleRec; static;

  class function TNYFormStyleRec.LoadFromJson(Val:string;serializer:TJsonSerializer):TNYFormStyleRec;
  begin
   serializer.Populate(Val,Result);
  end;
 -----------------------------------------------------------------*)
 //if not Assigned(EV) then EV:=FOnLoadFromJson;
 if not NP_DispErrMes('イベントが設定されていません(OnLoadFromJson)',Assigned(FOnLoadFromJson)) then exit;

 FDic.Clear;
 serializer := TJsonSerializer.Create;
 try
  try while Val<>'' do begin
       s:=NP_CutFirst(Val,_CRLF);
       SetRecord(_MaintainRecordID,FOnLoadFromJson(s,serializer));
      end;

      FSetIndexList;    ////

      FModified:=False;

  except NP_DispErrMes('データの読込時にエラーが発生しました');
  end;

 finally FreeAndNil(serializer);

 end;

end;

procedure TNYRecList.FilterEx(idx:integer;val:TValue);
begin
 FFilterIdx:=idx;
 FFilterVal:=Val;

 Filter;
end;


procedure TNYRecList.Filter;
var id:integer;
    Dt:T;
begin
 //------------------------------------------------------------------------------
 // フィルタの使用条件
 // あらかじめパラメータを設定しておく
 //　 フィルタ項目：フィールド文字列でフィルタするか、カテゴリでフィルタするか
 //   フィルタ対象：文字列フィールド、VST
 //　 フィルタ内容：フィルタ文字列、カテゴリID
 //------------------------------------------------------------------------------

 //FDispListクリア
 FDispList.Clear;

 //フィルタイベントがない場合は全表示
 if not Assigned(FOnFilter) then begin
  FSetIndexList;
  exit;
 end;

 //フィルタリング
 for id in FDic.Keys do begin
  if FOnFilter(Self,FDic[id],FFilterIdx,FFilterVal) then FDispList.add(id);
 end;

 //VSTカウント設定
 FVST.SetRowCountFocus(FDispList.Count);
end;

　
TNYBaseListについて

基本クラスです。内容は以下。

・変更状態の保持
・表示用IDのリストの保持
・抽象メソッドの定義
　・SaveRecordToJSON
　・LoadRecordFromJSON
　・Filter
・プロパティ
　・DispIDs　表示用IDリスト
　・Modified　変更状態
　・Count　　登録されている項目数
　・VST　　　表示用コンポーネント（現時点では TVirtualStringTree を想定）

表示用IDリストというのはリスト内の項目のうち、
リスト表示用コンポーネント上に表示する項目のIDを列挙したものです。

フィルタリングをした後の項目というとわかるでしょうか。
表示用にIDリストを用意しておきます。

これは項目の表示にはTVirtualStringTreeコンポーネントの利用を想定しているので
この様な形になっています。

レコードリストの本体はTNYRecList<T>てレコード型 T を指定して生成します。

　
TNYRecList<T>について

（以下準備中）