Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2004年12月31日] [更新 2020年11月20日] Delphi サンプルプログラム集
130_オブジェクトの保存 ( クラス型の保存 )
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
130_SaveComponent.zip [3.6 MB] 2020年11月20日版 (EXE 同梱)



  • 2017年04月17日 (これより前の履歴は省略)
  • コンポーネントをテキスト形式で保存するサンプルを追加
  • 2020年11月13日
  • 配列型のプロパティの保存のサンプルを追加




01_オブジェクトの保存と読み出し


クラス型のオブジェクトのデータを保存するサンプルです.
TStringList, TBitmag 等, あいるは TTreeView にはディスクへの保存用の SaveToFile メソッドや読み出し用の LoadFromFile のメソッドがあります.本ページで扱うのは,自作のクラス型のオブジェクトとしての保存と読み出しのサンプルです.

汎用性が高い方法として,TComponent から派生したクラスを作成し,その published なプロパティとして保存する方法もあります.これならばほとんどの型のデータを扱うことができます.TComponentList と組合わせて使用すると強力なのですが,ここでは,TDataというクラスのプロパティの一組のオブジェクトを保存,読出します.

  • (1) TData というクラスのインスタンスを生成
  • (2) その各プロパティに値を設定
  • (3) 保存する
  • (4) 読み出して,保存する前に設定した値を TMemo に表示
と言う手順でテストしていすま.TData には,クラス型のプロパティもあります.保存して読み出すと,それらのプロパティも保存できていることが分かります.このことは,あるクラスのオブジェクトを保存する際,そのプロパティに別のクラス型のオブジェクトがあれぱ,それらも保存することができることを意味しています.
保存可能なデータは,published で定義されているプロパティだけです.保存が必要なデータ (クラス型のオブジェクトも含めて) は,published なプロパティとして定義します.published 以外のプロパティの保存には,特別な方法が必要です (拙作のコンポーネントでは使用しています).


図1
設計時画面
図2
実行結果
  • [値のセット] [保存] そして [読出し] の結果

リスト1
クラス型オブジェクトの保存と読出し
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs;

type
  TSubData = class;

  TData = class(TComponent)
  private
    FIntVal  : Integer;
    FColor   : TColor;
    FFont    : TFont;
    FSubData : TSubData;
    procedure SetFont(const Value: TFont);
    procedure SetSubData(const Value: TSubData);
  protected
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
  published
    property IntVal  : Integer  read FIntVal   write FIntVal;
    property Color   : TColor   read FColor    write FColor;
    property Font    : TFont    read FFont     write SetFont;
    property SubData : TSubData read FSubData  write SetSubData;
  end;

  TSubData = class(TPersistent)
  private
    FName : String;
    FID   : Integer;
  public
  published
    property Name : String  read FName write FName;
    property ID   : Integer read FID   write FID;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FTestData : TData;
    FFileName : TFileName;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TData }

//-----------------------------------------------------------------------------
//  TDataクラスのCreate
//  オブジェクト型のプロパティはここで生成
//-----------------------------------------------------------------------------
constructor TData.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSubData := TSubData.Create;
  FFont    := TFont.Create;
end;

//-----------------------------------------------------------------------------
//  TDataクラスのDestroy.生成したオブジェクトも破棄
//-----------------------------------------------------------------------------
destructor TData.Destroy;
begin
  FreeAndNil(FSubData);
  FreeAndNil(FFont);

  inherited;
end;

//-----------------------------------------------------------------------------
//  Fontオブジェクトの設定
//-----------------------------------------------------------------------------
procedure TData.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

//-----------------------------------------------------------------------------
//  SubDataオブジェクトの設定
//  このプログラムでは必要な箇所はないのでwrite FSubDataでも可能であ
//  るが,後でエラーで悩まないために実装
//-----------------------------------------------------------------------------
procedure TData.SetSubData(const Value: TSubData);
begin
  FSubData.Assign(Value);
end;

//=============================================================================
//  フォームを生成したらTDataクラスのオブジェクトTestDataも生成
//  FFileNameは保存ファイル名
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FTestData  := TData.Create(Self);
  FFileName := ExtractFilePath(Application.ExeName) + 'ATest.dat';
end;

//=============================================================================
//  動作確認用のデータをセット
//  もちろんこれらの値が固定であればTDataのconstructorで設定しても構わない(ある
//  いは初期設定をconstructorで行う)
//
//  このコードでは,Memo1に表示するコードがないのでMemo1には表示されない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFont : TFont;
begin
  if Assigned(FTestData) then begin
    LFont := TFont.Create;
    try
      LFont.Size            := 12;
      LFont.Color           := clBlue;
      FTestData.Font         := LFont;
      FTestData.IntVal       := 2005;
      FTestData.Color        := clMoneyGreen;
      FTestData.SubData.Name := 'Mr.XRAY';
      FTestData.SubData.ID   := 1234567890;
    finally
      FreeAndNil(LFont);
    end;
  end;
end;

//=============================================================================
//  現在のデータを保存
//  TComponentの派生クラスプロパティなのでWriteComponentだけでOK
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFileStream : TFileStream;
begin
  LFileStream := TFileStream.Create(FFileName, fmCreate);
  try
    if Assigned(FTestData) then begin
      LFileStream.WriteComponent(FTestData);
    end;
  finally
    FreeAndNil(LFileStream);
  end;
end;

//=============================================================================
//  保存してあるデータを読出して表示
//  TComponentの派生クラスのプロパティなのでReadComponentだけでOK
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFileStream : TFileStream;
  LTestData   : TData;
begin
  Memo1.Clear;
  //読出データの確認のためにTDataの別の名前のオブジェクトを生成
  LTestData  := TData.Create(Self);
  try
    LFileStream := TFileStream.Create(FFileName, fmOpenRead);
    try
      LFileStream.ReadComponent(LTestData);
    finally
      LFileStream.Free;
    end;
    //読出したデータを表示
    Memo1.Lines.Add(IntToStr(LTestData.IntVal));
    Memo1.Lines.Add(LTestData.SubData.Name);
    Memo1.Lines.Add(IntToStr(LTestData.SubData.ID));
    Memo1.Color:=LTestData.Color;
    Memo1.Font.Assign(LTestData.Font);
  finally
    //テストなのですぐ破棄
    FreeAndNil(LTestData);
  end;
end;

end.




02_TFileStream を使用したコンポーネントの保存と読み出し


コンポーネントが 1 つだけの場合のサンプルです.上のサンプルの保存と読み出しだけのコードを取り出したものとなっています.

コンポーネントの状態を保存するのではなく,コンポーネントそのものを保存します.
同じ名前のコンポーネントは 1 つしか生成することはできません.そこで,既存のコンポーネントを削除してから読み出しています.
このサンプルコードで保存できるのは,published なプロパティだけです.published なプロパティとは,オブジェクトインスペクタで表示されているプロパティのことです.


図3
設計時画面
  • 右のパネルを保存する
図4
実行結果
  • [保存] そして [読出し] の結果
  • 読み出したコンポーネントの名前を確認

リスト2
TFileStream を使用したコンポーネントの保存と読み出しの例
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  コンポーネントをファイルに保存
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName   : String;
  LFileStream : TFileStream;
begin
  LFileName   := 'AAA.dat';
  LFileStream := TFileStream.Create(LFileName, fmCreate);
  try
    if Assigned(Panel1) then begin
      LFileStream.WriteComponent(Panel1);
    end;
  finally
    FreeAndNil(LFileStream);
  end;
end;

//=============================================================================
//  保存してあるコンポーネントを読み出して表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFileName   : String;
  LFileStream : TFileStream;
  LPanel      : TPanel;
begin
  //保存の時にPanel1の名前のコンポーネントで保存している
  //同名のコンポーネントは作成できないので削除
  FreeAndNil(Panel1);
  Update;
  Sleep(1000);

  LFileName  := 'AAA.dat';
  LPanel  := TPanel.Create(Self);
  LFileStream := TFileStream.Create(LFileName, fmOpenRead);
  try
    //親を指定しないと表示できない
    //親を指定しないとTStringsプロパティを持つTMemo,TListBox等が正常に読み出せない
    LPanel.Parent := Self;

    //コンポーネントを読み出す
    LFileStream.ReadComponent(LPanel);

    Application.MessageBox(PChar(LPanel.Name), 'コンポ名');
  finally
    LFileStream.Free;
  end;
end;

end.




03_TMemoryStream を使用したコンポーネントの保存と読み出し


以下のように,メモリストリームを使用することもできまます.
以下のコードは,上のサンプルを TMemoryStream を使用して書き直したサンプルです.


図5
設計時画面
  • 右のパネルを保存する
図6
実行結果
  • [保存] そして [読出し] の結果
  • 読み出したコンポのプロパティを表示

リスト3
TMemoryStream を使用したコンポーネントの保存と読み出しの例
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  コンポーネントをファイルに保存
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream : TMemoryStream;
  LCompo  : TComponent;
begin
  //保存するコンポーネント
  LCompo  := Panel1;
  LStream := TMemoryStream.Create;
  try
    //ストリームにコンポーネントを保存
    LStream.WriteComponent(LCompo);
    //そのストリームをファイルに保存
    LStream.SaveToFile('AAA.dat');
  finally
    FreeAndNil(LStream);
  end;
end;

//=============================================================================
//  保存してあるコンポーネントを読み出して表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStream    : TMemoryStream;
  LStrStream : TMemoryStream;
  LPanel     : TPanel;
begin
  //保存の時にPanel1の名前のコンポーネントで保存している
  //同名のコンポーネントは作成できないので削除
  FreeAndNil(Panel1);
  Update;
  Sleep(1000);

  LPanel  := TPanel.Create(Self);
  LStream := TMemoryStream.Create;
  try
    //ファイルからメモリストーリームに読み込む
    LStream.LoadFromFile('AAA.dat');
    //メモリストリームからクラスのインスタンスを取得
    LStream.ReadComponent(LPanel);
    //親を指定しないと表示されない
    LPanel.Parent := Self;

    //読み出したコンポーネントのプロパティを表示
    LStrStream := TMemoryStream.Create;
    try
      LStream.Position := 0;
      ObjectBinaryToText(LStream, LStrStream);
      LStrStream.Position := 0;
      Memo1.Lines.LoadFromStream(LStrStream);
    finally
      FreeAndNil(LStrStream);
    end;
  finally
    LStream.Free;
  end;
end;

end.




04_コンポーネントをテキスト形式で保存


上のサンプルで ObjectBinaryToText を施用して,コンポーネントをテキスト形式で表示しています.コンポーネントを保存する時にこの関数を使用すれば,コンポーネントをテキスト形式で保存てきます.その例です.


図7
実行画面
  • [保存] ボタンをクリックして保存する
図8
保存ファイルをテキストエディタで表示
  • テキスト形式で保存されている
  • このテキストを全て選択コピーして,フォームに貼り付けることができる

リスト4
コンポーネントをテキスト形式で保存
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  コンポーネントをファイルに保存
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream     : TMemoryStream;
  LSaveStream : TMemoryStream;
  LCompo      : TComponent;
begin
  //保存するコンポーネント
  LCompo  := Panel1;

  LStream     := TMemoryStream.Create;
  LSaveStream := TMemoryStream.Create;
  try
    //ストリームにコンポーネントを格納後,テキストに変換
    LStream.WriteComponent(LCompo);
    LStream.Position := 0;
    ObjectBinaryToText(LStream, LSaveStream);

    //変換したテキストをファイルに保存
    LSaveStream.SaveToFile('AAA.dat');
  finally
    FreeAndNil(LStream);
    FreeAndNil(LSaveStream);
  end;
end;

//=============================================================================
//  保存してあるコンポーネントを読み出して表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LReadStream : TMemoryStream;
  LStream     : TMemoryStream;
  LPanel      : TPanel;
begin
  //保存の時にPanel1の名前のコンポーネントで保存している
  //同名のコンポーネントは作成できないので削除
  FreeAndNil(Panel1);
  Update;
  Sleep(1000);

  LPanel      := TPanel.Create(Self);
  LReadStream := TMemoryStream.Create;
  LStream     := TMemoryStream.Create;
  try
    //親を指定しないと表示されない
    //親を指定しないとTStringsプロパティを持つTMemo,TListBox等が正常に読み出せない
    LPanel.Parent := Self;

    //ファイルからコンポーネントの情報を読み出す
    LReadStream.LoadFromFile('AAA.dat');
    //TMemoに表示
    Memo1.Lines.LoadFromStream(LReadStream);

    //バイナリに変換
    LReadStream.Position := 0;
    ObjectTextToBinary(LReadStream, LStream);

    //メモリストリームからコンポーネントを読み出す
    LStream.Position := 0;
    LStream.ReadComponent(LPanel);
  finally
    FreeAndNil(LReadStream);
    FreeAndNil(LStream);
  end;
end;

end.




05_ポインタ型や配列型は published なプロパティにできない


本ぺーじの最初のサンプルで確認したように,published なプロパティは保存して,再度読み込むことができることを確認しました.
ポインタ型や配列型は published なプロパティにできません.ポインタ型の変数を published プロパティにした次のようなクラスを作成しても,コンパイルするとエラーが発生します.


図9

リスト5
ポインタ型は published なプロパティにはできない
type
  TplPointerCompo = class(TComponent)
  private
    FPDblValue : PDouble;
  published
    property PDblValue : PDouble read  FPDblValue write  FPDblValue;
  end;


配列型も同じです.配列型の変数を published プロパティにした次のようなクラスを作成しても,コンパイルするとエラーが発生します.


図10

リスト6
配列型は published なプロパティにできない
type
  TDblArrayEx = array [0..9] of Double;

  TplArrayCompo = class(TComponent)
  private
    FDblArray : TDblArrayEx;
  published
    property DblArray : TDblArrayEx read  FDblArray write  FDblArray;
  end;


ポインタ型の変数の実体はメモリアドレスですから,保存しても意味がありません.
配列型は,published ではないプロパティにすれば保存可能にすることができます.

以下のコードは,静的配列型を public なプロパティにする例です.静的配列型は,上のコードのようにしても外部からは書き込みできません.以下のように配列プロパティとして,書き込みと読み込みのメソッドを作成して処理します.



リスト7
静的な配列型は配列プロパティとして実装する
type
  TDblArrayEx = array [0..9] of Double;

  TplArrayCompo = class(TComponent)
  private
    FDblArray : TDblArrayEx;
    function GetDblArray(Index: Integer): Double;
    procedure SetDblArray(Index: Integer; const Value: Double);
  public
    property DblArray[Index: Integer] : Double read GetDblArray write SetDblArray;
  end;

{ TplArrayCompo }

function TplArrayCompo.GetDblArray(Index: Integer): Double;
begin
  Result := FDblArray[Index];
end;

procedure TplArrayCompo.SetDblArray(Index: Integer; const Value: Double);
begin
  FDblArray[Index] := Value;
end;


動的配列の場合も,配列プロパティを実装して操作できますが,以下のように,配列プロパティにしなくても使用可能です.
配列要素数を public または published なプロパティにする必要性があるかは,配列の利用形態によります.配列型のプロパティを実装したクラス内だけで処理するような場合であれば,必要ないこともあります.配列型のプロパティを実装したクラスを使用する側でも,配列の代入やコピー操作だけで済むのであれば,必要がない場合も考えられます.



リスト8
動的な配列型は配列プロパティを使用しなくても操作可能
type
  TplArrayCompo = class(TComponent)
  private
    FDblArray : TDoubleDynArray;
    FArrayColCnt : Integer;
    procedure SetArrayColCnt(const Value: Integer);
  public
    property DblArray : TDoubleDynArray read FDblArray write FDblArray;
    property ArrayColCnt : Integer read FArrayColCnt write SetArrayColCnt;
  end;     

{ TplArrayCompo }

procedure TplArrayCompo.SetArrayColCnt(const Value: Integer);
begin
  FArrayColCnt := Value;
  SetLength(FDblArray, FArrayColCnt);
end; 




06_published ではないプロパティの保存と読み込み


published ではないプロパティや変数を保存,読み込み可能にするには,本ページの最初の方で述べたように特別な方法を使用します.それは,DefineProperties メソッドをオーバライドして処理する方法です.

次のコードは,本ページの最初のサンプルの TSubData というクラスに動的配列型の public なプロパティを追加して,それを保存,読み込み可能にするための DefineProperties メソッドと関係メソッドの実装例です.プロパティには「型」が必要です.したがって,配列は,型定義の配列を使用します.

DefineProperties メソッドの引数は TFiler です.その TFiler の DefineProperty メソッド,または DefineBinaryProperty メソッドで保存,読み込み用のメソッド名を指定します.それらの保存,読み込み用のメソッドは自分で定義して実装します.

保存,読み込み用のメソッド名は任意ですが,型は TWriterProc, TReaderProc, TReaderProc のいずれかです.メソッド (関数あるいは手続き) の型が決まっているということは,引数の数と引数の型と順番が決められているということです.保存と読み込み用のメソッドの引数はどれも 1 つだけで,引数の型は,TWriter, TReader, または TStream 型です.



リスト9
published でないプロパティや変数の保存と読み出しのための DefineProperties の実装例
{ TSubData }

procedure TSubData.DefineProperties(Filer: TFiler);
begin
  inherited;

  Filer.DefineBinaryProperty('Test_DblArray', ReadArrayData, WriteArrayData, True);
end;

procedure TSubData.WriteArrayData(AWriter: TStream);
begin
  AWriter.Write(FDblArray[0], FArrayColCnt * SizeOf(Double));
end;

procedure TSubData.ReadArrayData(AReader: TStream);
begin
  AReader.ReadBuffer(FDblArray[0], FArrayColCnt * SizeOf(Double));
end;


上のコードでは,引数の型に TStream を使用しています.保存 (書き込み) と読み込み用のメソッドの指定に DefineProperty メソッドを使用して,TWriter, TReader を使用しても結果は同じです.



リスト10
TWriter, TReader を使用する例
procedure TSubData.DefineProperties(Filer: TFiler);
begin
  inherited;

  Filer.DefineProperty('Test_DblArray', ReadArrayData, WriteArrayData, True);
end;

procedure TSubData.WriteArrayData(AWriter: TWriter);
begin
  AWriter.Write(FDblArray[0], FArrayColCnt * SizeOf(Double));
end;

procedure TSubData.ReadArrayData(AReader: TReader);
begin
  AReader.Read(FDblArray[0], FArrayColCnt * SizeOf(Double));
end;



[備考]
TButton 等の OnClick イベントの手続き名も任意ですが,型は TNotifyEvent です.TNotifyEvent 型の引数は 1 つだけで,TObject 型です.TButton 等も,実行時に生成して使用する時は,自分でイベント用のメソッドを定義して実装します.
コールバック関数も引数の数と型が決まっています.



本ページの最初のサンプルに DefineProperties 関係の処理を追加して,配列要素にデータを代入するコードと,読み出した時の処理のコードを追加して EXE を作成します.その EXE を起動して [値のセット] ボタンをクリックして [保存] をクリックしたら EXE を終了します.
再度 EXE を起動して [読出し] ボタンをクリックすると,図の下に示すサンプルコードの場合は下図の結果になり,保存した配列データが読み込まれているのが確認できます.


図11
配列型のプロパティを含めたクラス型の保存

リスト11
配列型の保存と読み出し機能を追加実装したクラスとその使用例
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs, Types;

type
  TSubData = class;

  TData = class(TComponent)
  private
    FIntVal  : Integer;
    FColor   : TColor;
    FFont    : TFont;
    FSubData : TSubData;
    procedure SetFont(const Value: TFont);
    procedure SetSubData(const Value: TSubData);
  protected
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
  published
    property IntVal  : Integer  read FIntVal   write FIntVal;
    property Color   : TColor   read FColor    write FColor;
    property Font    : TFont    read FFont     write SetFont;
    property SubData : TSubData read FSubData  write SetSubData;
  end;

  // TDoubleDynArray の使用には uses に Types が必要
  TSubData = class(TPersistent)
  private
    FName : String;
    FID   : Integer;
    FArrayColCnt : Integer;
    FDblArray : TDoubleDynArray;
    procedure WriteArrayData(AWriter: TStream);
    procedure ReadArrayData(AReader: TStream);
    procedure SetArrayColCnt(const Value: Integer);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    property DblArray : TDoubleDynArray read FDblArray write FDblArray;
  published
    property Name : String  read FName write FName;
    property ID   : Integer read FID   write FID;
    property ArrayColCnt : Integer read FArrayColCnt write SetArrayColCnt;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FTestData : TData;
    FFileName : TFileName;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  Form を生成したら TData クラスのオブジェクト TestData も生成
//  AFileName は保存ファイル名
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FTestData  := TData.Create(Self);
  FFileName := ExtractFilePath(Application.ExeName) + 'ATest.dat';

  Memo1.ScrollBars := ssBoth;
end;

//=============================================================================
//  動作確認用のデータをセット
//  もちろんこれらの値が固定であれば TData の constructor で設定しても構わない
//  あるいは初期設定を constructor で行う)
//
//  このコードでは,Memo1 に表示するコードがないので Memo1 には表示されない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFont : TFont;
  LCol  : Integer;
begin
  if Assigned(FTestData) then begin
    LFont := TFont.Create;
    try
      LFont.Size            := 12;
      LFont.Color           := clBlue;
      FTestData.Font         := LFont;
      FTestData.IntVal       := 2005;
      FTestData.Color        := clMoneyGreen;
      FTestData.SubData.Name := 'Mr.XRAY';
      FTestData.SubData.ID   := 1234567890;

      // 配列のデータを各要素に代入
      FTestData.SubData.ArrayColCnt := 5;
      for LCol := 0 to FTestData.SubData.ArrayColCnt - 1 do begin
        FTestData.SubData.DblArray[LCol] := (LCol + 1) * 100 + (LCol + 1) / 10.0;
      end;
    finally
      FreeAndNil(LFont);
    end;
  end;
end;

//=============================================================================
//  現在のデータを保存
//  TComponent の派生クラスプロパティなので WriteComponent だけで OK
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFileStream : TFileStream;
begin
  LFileStream := TFileStream.Create(FFileName, fmCreate);
  try
    if Assigned(FTestData) then begin
      LFileStream.WriteComponent(FTestData);
    end;
  finally
    FreeAndNil(LFileStream);
  end;
end;

//=============================================================================
//  保存してあるデータを読出して表示
//  TComponent の派生クラスのプロパティなので ReadComponent だけでOK
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFileStream : TFileStream;
  LTestData   : TData;
  LDouble     : Double;
  LCol        : Integer;
begin
  Memo1.Clear;
  // 読出データの確認のために TData の別の名前のオブジェクトを生成
  LTestData  := TData.Create(Self);
  try
    LFileStream := TFileStream.Create(FFileName, fmOpenRead);
    try
      LFileStream.ReadComponent(LTestData);
    finally
      LFileStream.Free;
    end;

    // 読出したデータを表示
    Memo1.Lines.Add(IntToStr(LTestData.IntVal));
    Memo1.Lines.Add(LTestData.SubData.Name);
    Memo1.Lines.Add(IntToStr(LTestData.SubData.ID));
    Memo1.Color := LTestData.Color;
    Memo1.Font.Assign(LTestData.Font);

    // 読み出した配列のデータを表示
    Memo1.Lines.Add('');
    for LCol := 0 to LTestData.SubData.ArrayColCnt - 1 do begin
      LDouble := LTestData.SubData.DblArray[LCol];
      Memo1.Lines.Add(FormatFloat('#0.000', LDouble));
    end;
  finally
    // テストなのですぐ破棄
    FreeAndNil(LTestData);
  end;
end;

{ TData }

//-----------------------------------------------------------------------------
//  TData クラスの Create
//  オブジェクト型のプロパティはここで生成
//-----------------------------------------------------------------------------
constructor TData.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSubData := TSubData.Create;
  FFont    := TFont.Create;
end;

//-----------------------------------------------------------------------------
//  TData クラスの Destroy.生成したオブジェクトも破棄
//-----------------------------------------------------------------------------
destructor TData.Destroy;
begin
  FreeAndNil(FSubData);
  FreeAndNil(FFont);

  inherited;
end;

//-----------------------------------------------------------------------------
//  Font オブジェクトの設定
//-----------------------------------------------------------------------------
procedure TData.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

//-----------------------------------------------------------------------------
//  SubData オブジェクトの設定
//  このプログラムでは必要な箇所はないので write FSubData でも可能
//  後でエラーで悩まないために実装
//-----------------------------------------------------------------------------
procedure TData.SetSubData(const Value: TSubData);
begin
  FSubData.Assign(Value);
end;

{ TSubData }

//-----------------------------------------------------------------------------
//  published でないプロパティ (変数値) の保存の例
//  DefineProperties メソッドをオーバーライドして処理する
//  ここでは TFiler.DefineBinaryProperty を使用
//
//  第 1 引数はクラス内での認識用の一意の値 (リソースの識別名)
//  第 2 引数は読み出し用のメソッド名 (メソッド名は任意)
//  第 3 引数は書き込み用のメソッド名 (メソッド名は任意)
//
//  基本的には配列要素数も保存して読出し可能にしておく必要がある
//  このサンプルでは配列の要素数は published なプロパティにしている
//-----------------------------------------------------------------------------
procedure TSubData.DefineProperties(Filer: TFiler);
begin
  inherited;

  Filer.DefineBinaryProperty('Test_DblArray', ReadArrayData, WriteArrayData, True);

  // 他に保存が必要な変数があれば追加する
end;

//-----------------------------------------------------------------------------
//  配列型プロパティの書き込み用メソッド
//-----------------------------------------------------------------------------
procedure TSubData.WriteArrayData(AWriter: TStream);
begin
  AWriter.Write(FDblArray[0], FArrayColCnt * SizeOf(Double));
end;

//-----------------------------------------------------------------------------
//  配列型プロパティの読み込み用メソッド
//-----------------------------------------------------------------------------
procedure TSubData.ReadArrayData(AReader: TStream);
begin
  // AReader.ReadBuffer(FDblArray[0], AReader.Size); でも OK
  AReader.ReadBuffer(FDblArray[0], FArrayColCnt * SizeOf(Double));
end;

//-----------------------------------------------------------------------------
//  配列の要素数プロパティ ArrayColCnt の設定用メソッド
//-----------------------------------------------------------------------------
procedure TSubData.SetArrayColCnt(const Value: Integer);
begin
  FArrayColCnt := Value;
  SetLength(FDblArray, FArrayColCnt);
end;

end.


保存したデータをテキストに変換すると,以下のように,クラス TData のプロパティとして保存されていることが確認できます.保存時の配列型のプロパティ名は,TFiler.DefineBinaryProperty メソッドで設定した名前になっています.

object TData
  IntVal = 2005
  Color = clMoneyGreen
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlue
  Font.Height = -16
  Font.Name = 'Tahoma'
  Font.Style = []
  SubData.Name = 'Mr.XRAY'
  SubData.ID = 1234567890
  SubData.ArrayColCnt = 5
  SubData.Test_DblArray = {
    66666666660659406666666666066940CDCCCCCCCCC472406666666666067940
    0000000000487F40}
end