Delphiクラス実装の面倒なことを自動化

Delphiの面倒なこと

Delphiでアプリを作るときに環境設定データをクラスTPersistentを継承して作るかと思います。クラスの例として色々なデータ型を内部に持つクラスを定義します。

testdata.pas

type
  TTestClass = class(TPersistent)
  private
    { Private 宣言 }
    FVInt: Integer;
    FVStr: string;
    FVBool: Boolean;
    FVDouble: Double;
    FVInt64: Int64;
    FVSet: TTestSet;
    FVColor: TColor;
    FVFontStyle: TFontStyles;
    FVDate: TDateTime;
    FVComp: TTestCompSub;
    FVFont: TFont;
    FVValiant: Variant;
    FVType: TTestType;
  public
    { Public 宣言 }
    procedure Assign(Source : TPersistent);override;
  published

    property VInt : Integer read FVInt write FVInt default 1;
    property VStr : string read FVStr write FVStr;
    property VBool : Boolean read FVBool write FVBool;
    property VDouble : Double read FVDouble write FVDouble;
    property VInt64 : Int64 read FVInt64 write FVInt64;
    property VColor : TColor read FVColor write FVColor;
    property VDate : TDateTime read FVDate write FVDate;
    property VFont : TFont read FVFont write FVFont;
    property VValiant :  Variant read FVValiant write FVValiant;
  end;

何も考えずに publishedを使っていますがコンポーネントとして実装しない限り publictと特に挙動は変わりません。※実際は全然違うのですが

こうやって作ったTTestClass型の実体 aFrom,aToを生成してaFromに値を代入します。
このaFromをaToにクラスごと代入する場合に　Assignを実装します

assign.pas

var
  aFrom,aTo : TTestClass;
begin
  aFrom := TTestClass.Create(Self);
  aTo := TTestClass.Create(Self);
  aFrom.FVInt := 1;
  aFrom.FVStr  := s;
  aFrom.FVDouble := 12.34;
  aFrom.FVInt64 := 123456789;
  aFrom.FVBool := True;
  aFrom.FVColor := $123456;
  aFrom.FVDate := Now;
  aFrom.FVFontStyle := [fsBold];
  aFrom.VValiant := 1.1;
  aTo.Assign(aFrom);
  aTo.Free;
  aFrom.Free;
end;
procedure TTestClass.Assign(Source: TPersistent);
var
  a : TTestClass;
begin
  if Source is TDataConfig then begin
    a := TTestClass(Source);
    FVInt := a.FVInt;
    FVStr  := a.FVStr;
    FVDouble := a.FVDouble;
    FVInt64 := a.FVInt64;
    FVBool := a.FVBool;
    FVColor := a.FVColor;
    FVDate := a.FVDate;
    FVFontStyle := a.FVFontStyle;
    FVValiant := a.FVValiant;   
  end
  else begin
    inherited;
  end;
end;

これが1回や2回ならまだしも、データクラスを作るたびに Assignを実装して手動で代入処理を書かなければなりません。
そのためデータ設計に時間がかかり肝心のプログラムの開発時間が短くなります。

これを自動で代入しようというのが今回紹介するプログラムです。

実装方法

クラスの定義があるファイルをインクルードしたらこのように変更します

変更前.pas

type
  TTestClass = class(TPersistent)
  private

変更後.pas

type
  TTestClass = class(TPersistentEx)
  private

たったこれだけで自動的に代入が出来るようになります。

仕組み

Delphiのpublished節に定義した変数は実行時型情報RTTIを持つのでこれを利用して代入を行うだけです。
仕組みは簡単ですがプログラムは膨大です。
TStringListには便利なValuesプロパティがありこれを使うと「キー」と「値」を管理する文字列リストを作る事が出来ます。

test.ini

VInt=1234;
VStr='abcd';
VBool=1;

しかしこのまま使うと存在しないキーを読み込んでエラーになったり変数の型ごとに読み書きが出来ないのでこれを拡張します。

StringListEx.pas

StringListEx.pas

unit StringListEx;

interface

uses
	Windows,Messages, SysUtils, Classes, Graphics, Controls,StdCtrls, ExtCtrls;

type
	TStringListEx = class(TStringList)
	private
		{ Private 宣言 }
    function GetCommaTextEx: string;
    procedure SetCommaTextEx(const Value: string);
    function CommaToMarkText(const str : string) : string;
    function MarkTextToComma(const str : string) : string;
	public
		{ Public 宣言 }
    property CommaTextEx : string read GetCommaTextEx write SetCommaTextEx;
    function GetInt() : Integer;
    function GetStr() : string;
    function GetColor() : TColor;
    function GetBool() : Boolean;
    function GetDateTime() : TDateTime;
    procedure SetInt(Value : Integer;Len : Integer = 0);
    procedure SetStr(Value : string;Len : Integer = 0);
    procedure SetBool(Value : Boolean);
    procedure SetDateTime(Value : TDateTime);
    function GetDateTimes(str : string;aDef : TDateTime) :TDateTime;
    procedure SetDateTimes(str : string;const Value : TDateTime);
    function GetStrs(str : string;aDef : string='') : string;
    procedure SetStrs(str : string;const Value : string);
    function GetInts(str : string;aDef : Integer=0) : Integer;
    procedure SetInts(str : string;const Value : Integer);
    function GetBools(str : string;aDef : Boolean=False) : Boolean;
    procedure SetBools(str : string;const Value : Boolean);
    function GetStrTblIndex(str : string;Tbl : array of string;aDef : Integer) : Integer;
    function GetFloat() : Double;
    function GetFloats(str : string;aDef : Double=0) : Double;
    procedure SetFloat(Value : Double);
    procedure SetFloats(str : string;Value : Double);
    function GetHexs(str : string;aDef : Integer=0) : Integer;
    procedure SetHexs(str : string;const Value,Digits : Integer);
	end;

implementation

{ TDataSetubiStringListEx }

function TStringListEx.CommaToMarkText(const str: string): string;
var
  s : string;
begin
  s := str;
  s :=StringReplace(s,'&','&a',[rfreplaceall]);
  s :=StringReplace(s,',','&c',[rfreplaceall]);
  s :=StringReplace(s,#$0d#$0a,'&d',[rfreplaceall]);
  result := s;
end;

function TStringListEx.GetBool: Boolean;
begin
  result := StrToIntDef(Strings[0],0) <> 0;
  Delete(0);
end;

function TStringListEx.GetColor: TColor;
begin
  result := StringToColor(Trim(Strings[0]));
  Delete(0);
end;

function TStringListEx.GetCommaTextEx: string;
var
  i : Integer;
  s : string;
begin
  result := '';
  if Count = 0 then exit;
  s :=  CommaToMarkText(Strings[0]);
  for i := 1 to Count-1 do begin
    s := s + ',' + CommaToMarkText(Strings[i]);
  end;
  result := s;
end;

function TStringListEx.GetDateTime: TDateTime;
begin
  result := StrToDateTime(Strings[0]);
  Delete(0);
end;

function TStringListEx.GetDateTimes(str: string;
  aDef: TDateTime): TDateTime;
var
  s : string;
begin
  result := aDef;
  s := Trim(Values[str]);
  if s = '' then exit;
  result := StrToDateTime(s);
end;

function TStringListEx.GetInt: Integer;
begin
  result := StrToIntDef(Trim(Strings[0]),-1);
  Delete(0);
end;

function TStringListEx.GetStr: string;
begin
  result := MarkTextToComma(Strings[0]);
  Delete(0);
end;

function TStringListEx.GetStrs(str: string; aDef: string =''): string;
var
  s : string;
begin
  result := aDef;
  s := Values[str];
  if s = '' then exit;
  result := s;
end;

function TStringListEx.GetInts(str: string; aDef: Integer): Integer;
var
  s : string;
begin
  result := aDef;
  s := Values[str];
  if s = '' then exit;
  result := StrToIntDef(s,aDef);
end;

function TStringListEx.GetBools(str: string; aDef: Boolean): Boolean;
var
  s : string;
begin
  result := aDef;
  s := Values[str];
  if s = '' then exit;
  result := Boolean(StrToIntDef(s,Integer(aDef)));
end;

function TStringListEx.MarkTextToComma(const str: string): string;
var
  s : string;
begin
  s := str;
  s := StringReplace(s,'&d',#$0d#$0a,[rfreplaceall]);
  s := StringReplace(s,'&c',',',[rfreplaceall]);
  s := StringReplace(s,'&a','&',[rfreplaceall]);
  result := s;
end;

procedure TStringListEx.SetBool(Value: Boolean);
begin
  Add(IntToStr(Integer(Value)));
end;

procedure TStringListEx.SetCommaTextEx(const Value: string);
var
  i : Integer;
  s,m : string;
begin
  Clear;
  for i := 1 to Length(Value) do begin
    m := Copy(Value,i,1);
    if m = ',' then begin
      Add(MarkTextToComma(s));
      s := '';
    end
    else begin
      s := s + m;
    end;
  end;
  //if s <> '' then Add(s);
  Add(MarkTextToComma(s));
end;

procedure TStringListEx.SetDateTime(Value: TDateTime);
begin
  Add(DateTimeToStr(Value));
end;

procedure TStringListEx.SetDateTimes(str: string; const Value: TDateTime);
begin
  Values[str] := DateTimeToStr(Value);
end;

procedure TStringListEx.SetInt(Value: Integer;Len : Integer = 0);
var
  s,ss : string;
begin
  if Len = 0 then begin
    Add(IntToStr(Value));
  end
  else begin
    ss := IntToStr(Len);
    s := '%' + ss + '.' + ss + 'd';
    s := Format(s,[Value]);
    Add(s);
  end;
end;

procedure TStringListEx.SetStr(Value: string;Len : Integer = 0);
var
  s : string;
begin
  s := CommaToMarkText(Value);
  if Len = 0 then begin
    Add(s);
  end
  else begin
    s := s + StringOfChar(' ',Len);
    s := Copy(s,1,Len);
    Add(s);
  end;
end;

procedure TStringListEx.SetStrs(str: string; const Value: string);
begin
  Values[str] := Value;
end;

procedure TStringListEx.SetInts(str: string; const Value: Integer);
begin
  Values[str] := IntToStr(Value);
end;

procedure TStringListEx.SetBools(str: string; const Value: Boolean);
begin
  Values[str] := IntToStr(Integer(Value));
end;

function TStringListEx.GetStrTblIndex(str: string; Tbl: array of string;
  aDef: Integer): Integer;
var
  s : string;
  i : Integer;
begin
  result := aDef;
  s := GetStrs(str,'');
  for i := 0 to High(Tbl) do begin
    if s = Tbl[i] then begin
      result := i;
      break;
    end;
  end;

end;

function TStringListEx.GetFloat: Double;
begin
  result := StrToFloat(Strings[0]);
  Delete(0);
end;

function TStringListEx.GetFloats(str: string; aDef: Double): Double;
var
  s : string;
begin
  result := aDef;
  s := Values[str];
  if s = '' then exit;
  result := StrToFloatDef(s,aDef);
end;

function TStringListEx.GetHexs(str: string; aDef: Integer): Integer;
var
  s : string;
begin
  result := aDef;
  s := Values[str];
  if s = '' then exit;
  result := StrToIntDef('$'+s,aDef);
end;

procedure TStringListEx.SetFloat(Value: Double);
begin
  Add(FloatToStr(Value));
end;

procedure TStringListEx.SetFloats(str : string;Value: Double);
begin
  Values[str] := Format('%3.2f',[Value]);
end;

procedure TStringListEx.SetHexs(str: string; const Value, Digits: Integer);
begin
  Values[str] := IntToHex(Value,Digits)
end;

end.

次に1つの文字列リストに複数のクラスのデータも管理できるようにセクションを作ります。セクションを利用するとこのようになります

test.ini

[SectionA]
VInt=1234
VStr='abcd'
VBool=1
[SectionB]
VInt=5678
VStr='efgh'
VBool=0

セクション付きの文字列リストを扱うためにTStringListKeyを作ります

TStringListKey.pas

TStringListKey.pas

unit StringListKey;

interface

uses
	Windows,Messages, SysUtils, Classes, Graphics, Controls,StdCtrls, ExtCtrls,
  StringListEx;

//--------------------------------------------------------------------------//
//  キーを管理するクラス                                                    //
//--------------------------------------------------------------------------//
type
	TStringListKey = class(TPersistent)
	private
		{ Private 宣言 }
    FKeys: TStringList;           // キーの一覧
    FValues: TList;               // 内容の管理
    function GetKeyValues(Key: string): TStringListEx;
	public
		{ Public 宣言 }
    constructor Create;
    destructor Destroy; override;
    function LoadFromFile(const FileName: string) : Boolean;
    function SaveToFile(const FileName: string) : Boolean;
    procedure StringsToKeys(t : TStringList);
    procedure KeysToStrings(t : TStringList);
    procedure Add(Key : string;Value : TStringList);
    procedure Delete(Key : string);
    procedure Clear();
    property Keys : TStringList read FKeys;
    property Values[Key : string] : TStringListEx read GetKeyValues;
  end;

implementation

{ TStringListKey }

constructor TStringListKey.Create;
begin
  FKeys   := TStringList.Create;
  FValues := TList.Create;
end;

destructor TStringListKey.Destroy;
var
  i : Integer;
begin
  for i := 0 to FValues.Count - 1 do begin
    TStringList(FValues[i]).Free
  end;
  FValues.Clear;
  FValues.Free;
  FKeys.Free;
  inherited;
end;

function TStringListKey.GetKeyValues(Key: string): TStringListEx;
var
  i : Integer;
begin
  result := nil;
  i := FKeys.IndexOf(Key);
  if i < 0 then exit;
  result := FValues[i];
end;

//**************************************************************************//
//  ～　キーと値をTStringList形式に変換　～                                 //
//**************************************************************************//
procedure TStringListKey.KeysToStrings(t: TStringList);
var
  i,j : Integer;
  t2 : TStringList;
  s : string;
begin
  t.Clear;
  for i := 0 to FKeys.Count-1 do begin
    t.Add('[' + FKeys[i] + ']');
    t2 := TStringList(FValues[i]);
    for j := 0 to t2.Count-1 do begin
      s := t2[j];
      t.Add(t2[j]);
    end;
  end;
  s := t.Text;
  s := s;
end;

//**************************************************************************//
//  ～　TStringList形式からキーと値を作成　～                               //
//**************************************************************************//
procedure TStringListKey.StringsToKeys(t: TStringList);
var
  s,sk : string;
  i,j,k : Integer;
  f : Boolean;
  t2 : TStringListEx;
begin
  Clear();
  f := False;
  j := 0;
  for i := 0 to t.Count-1 do begin
    s := t.Strings[i];
    if Length(s) = 0 then continue;
    if s[1] = '[' then begin
      if Length(s) > 2 then begin
        sk := Copy(s,2,Length(s)-2);
        FKeys.Add(sk);
        if f then begin
          t2 := TStringListEx.Create;
          for k := j to i-1 do begin
            t2.Add(t[k]);
          end;
          FValues.Add(Pointer(t2));
        end;
        j := i + 1;
        f := True;
      end;
    end;
  end;
  if f then begin
    t2 := TStringListEx.Create;
    t2.Clear;
    for k := j to t.Count-1 do begin
      t2.Add(t[k]);
    end;
    FValues.Add(Pointer(t2));
  end;

end;

//**************************************************************************//
//  ～　ファイルから読み込む　～                                            //
//**************************************************************************//
function TStringListKey.LoadFromFile(const FileName: string) : Boolean;
var
  t : TStringList;
begin
  t := TStringList.Create;
  try
    result := False;
    t.LoadFromFile(FileName);      // ファイルを読み込む
    StringsToKeys(t);              // キーと値との形式に変換
    result := True;
  finally
    t.Free;
  end;
end;

//**************************************************************************//
//  ～　ファイルに書き込む　～                                              //
//**************************************************************************//
function TStringListKey.SaveToFile(const FileName: string) : Boolean;
var
  t : TStringList;
begin
  t := TStringList.Create;
  try
    result := False;
    KeysToStrings(t);            // StringList形式に変換
    t.SaveToFile(FileName);      // ファイルに書き込む
    result := True;
  finally
    t.Free;
  end;
end;

//**************************************************************************//
//                                                                          //
//  ～　新しい値を追加　～                                                  //
//                                                                          //
//   - Input -  Key   : 追加するキー                                        //
//              Value : 追加する内容                                        //
//                                                                          //
//   - Output - なし                                                        //
//                                                                          //
//**************************************************************************//
procedure TStringListKey.Add(Key: string; Value: TStringList);
var
  i : Integer;
  t : TStringListEx;
begin
  i := FKeys.IndexOf(Key);
  if i < 0 then begin
    FKeys.Add(Key);
    t := TStringListEx.Create;
    t.Assign(Value);
    FValues.Add(Pointer(t));
  end
  else begin
    TStringList(FValues[i]).Assign(Value);
  end;
end;

//**************************************************************************//
//  ～　キーを削除　～                                                      //
//**************************************************************************//
procedure TStringListKey.Delete(Key: string);
var
  i : Integer;
begin
  i := FKeys.IndexOf(Key);
  if i = -1 then exit;
  FKeys.Delete(i);
  TStringList(FValues[i]).Free;
  FValues.Delete(i);

end;

//**************************************************************************//
//  ～　全てのキーと値を初期化　～                                          //
//**************************************************************************//
procedure TStringListKey.Clear;
var
  i : Integer;
begin
  FKeys.Clear;
  for i := 0 to FValues.Count - 1 do begin
    TStringList(FValues[i]).Free
  end;
  FValues.Clear;
end;

end.

最後に実行時型情報を利用して保存や読み込みを行うクラスを実装します

StringListRtti

StringListRtti.pas

unit StringListRtti;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,StringListEx,TypInfo;

type
	TPersistentEx = class(TPersistent)
	public
		{ Public 宣言 }
    procedure Assign(Source : TPersistent);override;
	end;


//--------------------------------------------------------------------------//
//  拡張TPersistentクラス（DefinePropertiesメソッドの強制公開）             //
//--------------------------------------------------------------------------//
type  TStringListRttiPersistent = class(TPersistent);

//--------------------------------------------------------------------------//
//  実行時型情報を利用したオブジェクトの保存と読み込みするクラス            //
//--------------------------------------------------------------------------//
type
// 型種類
  TRttiType = (rtNormal,rtBoolean,rtImitation,rtComponent,rtClass,rtCollection,rtRootClass);
	TStringListRtti = class(TStringListEx)
	private
		{ Private 宣言 }
    FObject : TObject;
    FInfo  : PTypeInfo;
    FData  : PTypeData;
    FProps : PPropList;
    procedure GetRttiInfo();
    function CheckRttiType(aProp : PPropInfo) : TRttiType;
    function CheckImitationProperty(aObject : TObject) : Boolean;
    procedure SaveToObjectNormal(i : Integer);
    procedure LoadFromObjectNormal(i : Integer);
	public
		{ Public 宣言 }
    // Key=Value 形式の文字列リストを指定されたオブジェクトの変数に書き込む
    function LoadFromObject(aObject : TObject) : Boolean;
    // 指定されたオブジェクトを解析して Key=Value形式の文字列リストにする
    function SaveToObject(aObject : TObject) : Boolean;
	end;

implementation

{ TStringListRtti }

function TStringListRtti.CheckImitationProperty(aObject: TObject): Boolean;
var
  stm : TWriter;
  m : TStringStream;
  s : string;
begin
  result := False;
  if aObject = nil then exit;
  m := TStringStream.Create(s);
  stm := TWriter.Create(m,4096);
  try
    //result := False;
    TStringListRttiPersistent(aObject).DefineProperties(stm);
    stm.FlushBuffer;
    m.Seek(0, soFromBeginning);
    result := m.DataString <> '';
  finally
    m.Free;
    stm.Free;
  end;
end;

function TStringListRtti.CheckRttiType(aProp: PPropInfo): TRttiType;
var
  PName : string;
begin
  result := rtNormal;
  PName := string(aProp.Name);
  if (aProp.PropType^.Kind = tkClass) then begin
    if (CheckImitationProperty(GetObjectProp(FObject,aProp))) then begin
      // 偽プロパティの処理
      result := rtImitation;
    end
    else if GetObjectProp(FObject,PName) <> nil then begin
      // クラスの処理
      if GetObjectProp(FObject,PName) is TComponent then begin
        // TComponentからの派生クラスのとき
        result := rtComponent;
      end
      else begin
        // TComponent以外からの派生クラスのとき
        result := rtClass;
      end;
    end;
  end
  else if aProp.PropType^.Name = 'Boolean' then begin
    result := rtBoolean;
  end;
end;

procedure TStringListRtti.GetRttiInfo;
begin
  FInfo := FObject.ClassInfo;
  FData := GetTypeData(FInfo);

  GetMem(FProps,FData^.PropCount * SizeOf(PPropInfo));
  GetPropInfos(FInfo,FProps);

end;

function TStringListRtti.LoadFromObject(aObject: TObject): Boolean;
var
  i : Integer;
begin
  FObject := aObject;
  GetRttiInfo();
  for i :=0  to FData^.PropCount-1 do begin
    if not IsStoredProp(FObject,FProps^[i]) then Continue;
    LoadFromObjectNormal(i);
  end;
  result := true;
end;

procedure TStringListRtti.LoadFromObjectNormal(i: Integer);
var
  aStr : string;
  aInt : Integer;
  aInt64 : Int64;
  aFloat : Double;
  p : PPropInfo;
  PName : string;
  aByte : Byte;
begin
  p := FProps[i];
  PName := string(FProps^[i].Name);
  case CheckRttiType(p) of
    rtNormal: begin
      case p.PropType^.Kind of
        tkChar,
        tkWChar,
        tkInteger : begin
          //  Integer型の読み込み
          aInt := GetInts(PName,0);
          SetOrdProp(FObject,p,aInt);
        end;
        tkUString,
        tkLString,
        tkWString,
        tkString : begin
          //  String型の読み込み
          aStr := GetStrs(PName,'');
          SetStrProp(FObject,p,aStr);
        end;
        tkFloat : begin
          //  Float型の読み込み
           aFloat := GetFloats(PName,0);
           SetFloatProp(FObject,p,aFloat);
        end;
        tkInt64 : begin
          //  Int64型の読み込み
          aStr := GetStrs(PName,'');
          aInt64 := StrToInt64Def(aStr,0);
          SetInt64Prop(FObject,p,aInt64);
        end;
        tkEnumeration : begin
          //  列挙型の読み込み
          aByte := GetInts(PName,0);
          SetOrdProp(FObject,p,aByte);
        end;
        tkSet : begin
          //  集合型の読み込み
          aInt := GetInts(PName,0);
          SetOrdProp(FObject,p,aInt);
        end;
      end;
    end;
    rtBoolean : begin
      // Boolean型の読み込み
      aInt := GetInts(PName,0);
      SetOrdProp(FObject,p,aInt);
    end;
    else begin
    end;
  end;

end;

function TStringListRtti.SaveToObject(aObject: TObject): Boolean;
var
  i,aInt : Integer;
  PName : string;
begin
  FObject := aObject;
  GetRttiInfo();
  for i :=0  to FData^.PropCount-1 do begin
    if not IsStoredProp(FObject,FProps^[i]) then Continue;
    PName := string(FProps^[i].Name);
    case CheckRttiType(FProps^[i]) of
      rtNormal: SaveToObjectNormal(i);
      rtBoolean : begin
        //  Boolean型の書き込み
        aInt := GetOrdProp(FObject,PName);
        SetInts(PName,aInt);
      end;
    end;
  end;
  result := True;
end;

procedure TStringListRtti.SaveToObjectNormal(i: Integer);
var
  aStr : string;
  aInt : Integer;
  aInt64 : Int64;
  aFloat : Double;
  s,PName : string;
begin
  PName := string(FProps^[i].Name);
  case FProps^[i].PropType^.Kind of
    tkChar,
    tkWChar,
    tkInteger : begin
      //  Integer型の書き込み
      aInt := GetOrdProp(FObject,PName);
      SetInts(PName,aInt);
    end;
    tkInt64 : begin
      //  Int64型の書き込み
      aInt64 := GetInt64Prop(FObject,PName);
      s := IntToStr(aInt64);
      SetStrs(PName,s);
    end;
    tkString : begin
      //  短い文字列型の書き込み
      aStr := GetStrProp(FObject,PName);
      SetStrs(PName,aStr);
    end;
    tkUString,
    tkLString,
    tkWString : begin
      //  長い文字列型の書き込み
      aStr := GetStrProp(FObject,PName);
      SetStrs(PName,aStr);
    end;
    tkEnumeration : begin
      //  列挙型の書き込み
      aInt := GetOrdProp(FObject,PName);
      SetInts(PName,aInt);
    end;
    tkSet : begin
      //  集合型の書き込み
      aInt := GetOrdProp(FObject,PName);
      SetInts(PName,aInt);
    end;
    tkFloat : begin
      //  Float型の書き込み
      aFloat := GetFloatProp(FObject,PName);
      aStr := FloatToStr(aFloat);
      SetStrs(PName,aStr);
    end;
  end;
end;

{ TPersistentEx }

procedure TPersistentEx.Assign(Source: TPersistent);
var
  a : TPersistentEx;
  tk : TStringListRtti;
begin
  if Source is TPersistentEx then begin
    a := TPersistentEx(Source);
    tk := TStringListRtti.Create;
    try
      tk.SaveToObject(a);
      tk.LoadFromObject(Self);
    finally
      tk.Free;
    end;
  end
  else begin
    inherited;
  end;
end;

ダウンロード

ダウンロードはここ

注意事項

独自のクラスや変数の型によっては非対応です。
独自クラスを実装した場合は、Assignを継承してinheritedと独自クラスへのAssignを実装すれば対応出来ます。

制作者を勝手に名乗る以外は改変や配布など使用に制限はありません。

なにかあればコメントとかで対応しますが、これは20年前に作ったものなので思い出しながらになります。

おわりに

Assignの実装部分を見ると実は TStringListRttiを生成して SaveToObject、 LoadFromObject(Self)しているだけです。

たったこれだけでもうAssignを実装する必要がなくなるから不思議ですね。

TStringListRttiはTStringListを継承した文字列リストなのでファイルへの保存や読み込みも可能です。つまりデータの保存と復元も自動です。