お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





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

"レコード型をTListで管理する"

この発言に対し以下のコメントが寄せられています
#01296 らせん企画 さん RE:レコード型をTListで管理する

 TList を上書きして作ったレコード型を管理するクラスのサンプルです。  おかしなところがあればご指摘ください。添削歓迎します。 (#01293 はバグありのため削除しました。(Record の定義がstringのままだった) 長文を落としてしまわれた方、すいませんでした。) {使用例 後述のクラスをusesするなどし、あとはTStringListと基本的に同じ} procedure TForm1.Button1Click(Sender: TObject); var AList: TAddList; a: TAddress; Cnt: integer; begin AList := TAddList.Create('E:\Bin'); try AList.LoadFromFile; //ファイル読み込み a.Age := 20; a.Name := '青木'; AList.Add(a); //データ追加 Cnt := AList.Find('青木'); //名前で検索 if Cnt >= 0 then begin with AList[Cnt] do Label1.Caption := Format('%s %2d',[Name,Age]); a.Age := 100; a.Name := '山田'; AList[Cnt] := a; //データ内容変更 with AList[Cnt] do Label2.Caption := Format('%s %2d',[Name,Age]); AList.Delete(Cnt); //データ削除 end; AList.SaveToFile; //ファイル保存 finally AList.Free; end; end; YRL06713 リービ //------------------------------------------------------------ interface uses SysUtils, Classes; type TAddress = packed record Name : array[0..19] of char; //string を使うと保存時などにテクがいる。 Age : integer; end; TADDList = class(TList) private FFileName: TFileName; function GetData(Index: integer): TAddress; procedure IdxError(Index: integer); procedure PutDate(Index: Integer; const Value: TAddress); public constructor Create(const Dir: string); destructor Destroy; override; function Add(Data: TAddress): Integer; procedure Clear; override; procedure Delete(Index: Integer); function Find(const Name: string): Integer; procedure LoadFromFile; procedure LoadFromStream(Stream: TStream); procedure SaveToFile; procedure SaveToStream(Stream: TStream); property FileName: TFileName read FFileName; property Data[Index: Integer]:TAddress read GetData write PutDate; default; published end; implementation { TADDList } const SizeOfRec = SizeOf(TAddress); FName = 'ADDRESS.DAT'; //ファイル名固定 type PREC = ^TAddress; function TAddList.Add(Data: TAddress): Integer; var NewData:PREC; begin New(NewData); System.Move( Data, NewData^, SizeOf(Data) ); //これでOKですよね? result := inherited Add(NewData); end; procedure TAddList.Clear; var i:integer; begin for i:=0 to Count-1 do Dispose( PREC(Items[i]) ); inherited Clear; end; constructor TAddList.Create(const Dir: string); begin FFileName := Dir + '\' + FName; //DirectoryExists と最後の'\'ノーチェック inherited Create; end; procedure TAddList.Delete(Index: Integer); begin idxError(Index); Dispose( PREC(Items[Index]) ); inherited Delete(Index); end; destructor TAddList.Destroy; begin inherited Destroy; end; //名前で検索 データ重複には未対応 function TAddList.Find(const Name: string): Integer; begin result := -1; repeat inc(result); until (result=Count) or (PRec(Items[result])^.Name = Name); if result = Count then result := -1; end; function TAddList.GetData(Index: integer): TAddress; begin idxError(Index); Result := TAddress(Items[Index]^); end; procedure TAddList.IdxError(Index: integer); begin if (Index < 0) or (Index >= Count) then raise Exception.Create('インデックスがリストの範囲を超えています。'); end; procedure TAddList.PutDate(Index: Integer; const Value: TAddress); begin idxError(Index); TAddress(Items[Index]^) := Value; end; procedure TAddList.LoadFromFile; var Stream: TFileStream; begin if not FileExists(FileName) then exit; Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try LoadFromStream(Stream); finally Stream.Free; end; end; procedure TAddList.LoadFromStream(Stream: TStream); var tmp: TAddress; begin Clear; while Stream.Position < Stream.Size do begin Stream.ReadBuffer(tmp, SizeOfRec); Add(tmp); end; end; procedure TAddList.SaveToFile; var Stream: TFileStream; begin if Count = 0 then exit; Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite); try //常に上書保存 SaveToStream(Stream); finally Stream.Free; end; end; procedure TAddList.SaveToStream(Stream: TStream); var i: Integer; tmp: TAddress; begin for i:=0 to Count-1 do begin tmp := GetData(i); Stream.WriteBuffer(tmp, SizeOfRec); end; end;  Original document by リービ 氏 ID:(YRL06713)



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

Copyright 1996-2002 Delphi Users' Forum