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日
配列型のプロパティの保存のサンプルを追加
クラス型のオブジェクトのデータを保存するサンプルです.
TStringList, TBitmag 等, あいるは TTreeView にはディスクへの保存用の SaveToFile メソッドや読み出し用の LoadFromFile のメソッドがあります.本ページで扱うのは,自作のクラス型のオブジェクトとしての保存と読み出しのサンプルです.
汎用性が高い方法として,TComponent から派生したクラスを作成し,その published なプロパティとして保存する方法もあります.これならばほとんどの型のデータを扱うことができます.TComponentList と組合わせて使用すると強力なのですが,ここでは,TDataというクラスのプロパティの一組のオブジェクトを保存,読出します.
(1) TData というクラスのインスタンスを生成
(2) その各プロパティに値を設定
(3) 保存する
(4) 読み出して,保存する前に設定した値を TMemo に表示
と言う手順でテストしていすま.TData には,クラス型のプロパティもあります.保存して読み出すと,それらのプロパティも保存できていることが分かります.このことは,あるクラスのオブジェクトを保存する際,そのプロパティに別のクラス型のオブジェクトがあれぱ,それらも保存することができることを意味しています.
保存可能なデータは,published で定義されているプロパティだけです.保存が必要なデータ (クラス型のオブジェクトも含めて) は,published なプロパティとして定義します.published 以外のプロパティの保存には,特別な方法が必要です (拙作のコンポーネントでは使用しています).
図1
設計時画面
図2
実行結果
[値のセット] [保存] そして [読出し] の結果
copy code
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 を使用したコンポーネントの保存と読み出しの例
copy code
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 を使用したコンポーネントの保存と読み出しの例
copy code
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 .
上のサンプルで ObjectBinaryToText を施用して,コンポーネントをテキスト形式で表示しています.コンポーネントを保存する時にこの関数を使用すれば,コンポーネントをテキスト形式で保存てきます.その例です.
図7
実行画面
図8
保存ファイルをテキストエディタで表示
テキスト形式で保存されている
このテキストを全て選択コピーして,フォームに貼り付けることができる
copy code
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 なプロパティにはできない
copy code
type
TplPointerCompo = class (TComponent)
private
FPDblValue : PDouble;
published
property PDblValue : PDouble read FPDblValue write FPDblValue;
end ;
配列型も同じです.配列型の変数を published プロパティにした次のようなクラスを作成しても,コンパイルするとエラーが発生します.
図10
リスト6
配列型は published なプロパティにできない
copy code
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
静的な配列型は配列プロパティとして実装する
copy code
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
動的な配列型は配列プロパティを使用しなくても操作可能
copy code
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 の実装例
copy code
{ 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 を使用する例
copy code
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
配列型の保存と読み出し機能を追加実装したクラスとその使用例
copy code
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