お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"配列をメンバに持つオブジェクトの保存"



こんにちは、凛です。
ちょっと必要があって配列をメンバに持つオブジェクトを永続化させたくなり
ちょっと作ったのであげておきます。
サンプルなので、単純にしてありますが、この雛形からあとは、
    procedure ReadArray(reader:TStream);
    procedure WriteArray(writer:TStream);
の中身が相互につじつまが合うようにしておけばなんでもやり放題ですね。


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms,Dialogs,StdCtrls, ExtCtrls;

type
  TA=Class(TComponent)
  private
    function GetArr(index: integer): Double;
    procedure SetArr(index: integer; const Value: Double);
    function getCount: integer;
  public
    FArr:Array of Double;
    constructor Create(AOwner:TComponent);override;
    procedure DefineProperties(Filer:TFiler);overRide;
    //名前は任意 DefinePropertiesで設定しているものと合わせればOK
    procedure ReadArray(reader:TStream);
    procedure WriteArray(writer:TStream);
    property Arr[index:integer]:Double read GetArr write SetArr;
    //必須ではない今回便利なので実装しているだけ
    property ArrCount:integer read getCount;
  end;

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

constructor TA.Create(AOwner: TComponent);
begin
  inherited;
  //サンプルなのでここで長さを決める
  //実際にはデータを格納する時に調整すればOK
  SetLength(FArr,Random(10)+5);
end;

procedure TA.defineproperties(Filer:TFiler);
var
  HasData : Boolean;
begin
  inherited;
  HasData := Length(FArr) <> 0;
  Filer.DefineBinaryProperty('MyArray',ReadArray,WriteArray, HasData );
end;

function TA.GetArr(index: integer): Double;
begin
  result:=FArr[index];
end;

function TA.getCount: integer;
begin
  result:=Length(FArr);
end;

procedure TA.ReadArray(reader:TStream);
var
  count,i:integer;
begin
  Reader.Read(Count,SizeOf(integer));
  setLength(FArr,count);
  for i:= 0 to Count-1 do
  begin
    Reader.Read(FArr[i],SizeOf(Double));
  end;
end;

procedure TA.SetArr(index: integer; const Value: Double);
begin
  FArr[index]:=Value;
end;

procedure TA.WriteArray(writer:TStream);
var
  i:integer;
  count:integer;
begin
   count:=Length(FArr);
   writer.Write(count,SizeOf(integer));
   for i:= 0 to Length(FArr) do
   begin
     writer.Write(FArr[i],SizeOf(Double));
   end;
end;

//TDateModuleを使ってオブジェクトを保存
procedure TForm1.Button1Click(Sender: TObject);
var
   i,j:integer;
   a:TA;
   DataModule:TDataModule;
   Stream : TFileStream;
begin
   DataModule:=TDataModule.create(self);
   for i:= 0 to 99 do
   begin
      //オブジェクトを作成してサンプルデータを作っていれてるだけ
      a:=TA.create(DataModule);
      for j:= 0 to a.ArrCount-1 do a.Arr[j]:=j/10;
   end;
   WriteComponentResFile('c:\poo.dat',DataModule);
   DataModule.free;
end;

//TDataModuleを使ってオブジェクトを読み込み
procedure TForm1.Button2Click(Sender: TObject);
var
   i,j:integer;
   DataModule:TDataModule;
   Stream : TFileStream;
begin
   DataModule:=TDataModule.create(self);
   //読み込んだときに生成も自動的にやってくれる
   ReadComponentResFile('c:\poo.dat',DataModule);

   //単に読み込んだオブジェクトのプロパティを表示するためのルーチン
   //読み込んだオブジェクトの利用方法のサンプルともいえる
   //一部しか表示していないのは単にしていないだけ他意はない
   for i:= 0 to DataModule.ComponentCount-1 do
      if DataModule.components[i] is TA then
        for j:= 0 to TA(DataModule.Components[i]).ArrCount-1 do
         ListBox1.Items.add(
            FloatToStr(TA(DataModule.Components[i]).Arr[j]));
   DataModule.free;
end;

initialization
    RegisterClasses([TA]);
end.

                              2001/04/02(Mon) 05:38pm  MXB01744 凛
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/04/04 -

Original document by 凛              氏 ID:(MXB01744)


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

Copyright 1996-2002 Delphi Users' Forum