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