この発言は
#00710　ＴＮ            さんのレコード風Objectを集めてSave/Loadする
に対するコメントです



多階層の所有関係を構築する例
　→　基底TDataObjectは所有物を書き出すように改造してある

unit Unit1;

interface

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

type
  // 所有物をストリームに書き出すデータオブジェクトの基底
  TDataObject = class(TComponent)
  protected
    function  GetChildOwner: TComponent; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent);
              override;
  end;

  // データクラスの例その１
  TMyClass1 = class(TDataObject)
  private
    FData1: integer;
    FData2: Double;
  published
    property Data1: integer read FData1 write FData1;
    property Data2: Double read FData2 write FData2;
  end;

  // データクラスの例その２
  TMyClass2 = class(TDataObject)
  private
    FData3: string;
    FData4: Currency;
    FData5: boolean;
  published
    property Data3: string read FData3 write FData3;
    property Data4: Currency read FData4 write FData4;
    property Data5: boolean read FData5 write FData5;
  end;

  // Test Form
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    SaveBtn: TButton;
    LoadBtn: TButton;
    ShowData: TButton;
    AddClass2Inst: TButton;
    AddClass1Inst: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ObjCountLabel: TLabel;
    Label2: TLabel;
    LastClass1Data: TButton;
    procedure FormCreate(Sender: TObject);
    procedure AddClass1InstClick(Sender: TObject);
    procedure AddClass2InstClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure ShowDataClick(Sender: TObject);
    procedure LastClass1FirstChildDataClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    Collection: TDataModule;
  end;



var
  Form1: TForm1;

implementation

{$R *.DFM}

function TDataObject.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TDataObject.GetChildren( Proc: TGetChildProc;
                                      Root: TComponent);
var
  i: Integer;
  Compo: TComponent;
begin
  inherited GetChildren(Proc, Root);
  for i := 0 to ComponentCount - 1 do begin
    Compo := Components[i];
    Proc(Compo);
  end;
end;

// データをまとめておくためのコレクションオブジェクトを用意
procedure TForm1.FormCreate(Sender: TObject);
begin
  Collection := TDataModule.Create(Self);
  Collection.Name := 'Collection';
  // クラスの登録
  RegisterClasses([TMyClass1, TMyClass2]);
end;

// 新データオブジェクトの生成その1（こっちを先にやってね）
procedure TForm1.AddClass1InstClick(Sender: TObject);
begin
  // Collectionを所有者にしてオブジェクトを生成する
  with TMyClass1.Create(Collection) do begin
    Data1 := StrToInt(Memo3.Lines[0]);
    Data2 := StrToFloat(Memo3.Lines[1]);
  end;
  ObjCountLabel.Caption := InttoStr(Collection.ComponentCount);
end;

// 新データオブジェクトの生成その2
procedure TForm1.AddClass2InstClick(Sender: TObject);
var
  AOwner: TComponent;
begin
  // 直前に生成したTMyClass1のインスタンスをOwnerにして生成
  AOwner := Collection.Components[Collection.ComponentCount-1];
  with TMyClass2.Create(AOwner) do begin
    Data3 := Memo4.Lines[0];
    Data4 := StrToCurr(Memo4.Lines[1]);
    if Memo4.Lines[2] = 'Y' then begin
      Data5 := True;
    end else begin
      Data5 := False;
    end;
  end;
  ObjCountLabel.Caption := InttoStr(Collection.ComponentCount);
end;

// データの書き出し
procedure TForm1.SaveBtnClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    WriteComponentResFile(SaveDialog1.FileName, Collection);
end;

// データの読込
procedure TForm1.LoadBtnClick(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    Collection.Free;                       // いったん捨てて
    Collection := TDataModule.Create(Self); // 新規生成
    ReadComponentResFile(OpenDialog1.FileName, Collection);
    ShowDataClick(Sender);        // 表示
  end;
end;

// データの一気全部表示
procedure TForm1.ShowDataClick(Sender: TObject);
var
  SI,SO: TStream;
begin
  SI := TMemoryStream.Create;
  SO := TMemoryStream.Create;
  try
    SI.WriteComponent(Collection); //ストリームに書き出して
    SI.Seek(0, soFromBeginning);
    ObjectBinaryToText(SI, SO);    // テキストに一気変換
    SO.Seek(0, soFromBeginning);
    Memo1.Lines.LoadFromStream(SO); // 表示
  finally
    SI.Free;
    SO.Free;
  end;
end;

// データオブジェクトのひとつを取り出して表示
procedure TForm1.LastClass1FirstChildDataClick(Sender: TObject);
var
  i: integer;
  Elem: TComponent;
begin
  // 最後にaddした「子」から検索
  for i := Collection.ComponentCount-1 downto 0 do begin
    Elem := Collection.Components[i]; // 一個を取り出して
    // その「子」の「子」のデータを表示
    Label2.Caption :=
      CurrtoStr((Elem.Components[0] as TMyClass2).Data4); //値を表示
    break;
  end;
end;

end.

                                                  ＴＮ(CQJ01721)

Original document by ＴＮ            氏 ID:(CQJ01721)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。