この発言に対し以下のコメントが寄せられています

#01384　HATENA          さん　レコード型のデータをTListで２重ソート

#01385　HATENA          さん　レコード型データの読み書き(TFlieStream版







　レコード型のデータを、TList にセットしてファイルに保存、読み込みします。
ファイルの入出力は、プリミティブな(Pascal的な)型付きファイルを使っています。

　データは DrawGrid に表示します。件数が多いときは、StringGrid よりはるか
に高速です。ただし、編集するときは、OnGetEditText, OnSetEditText 等に自前
でコードを書く必要があります。

nifty:FDELPHI/MES/6/34796 の改訂版です。



フォームにボタンを３つと、DrawGrid を置いて下さい。
ボタンの名前は、btnSampleCreate, btnSave, btnLoad
DrawGrid の OnDrawCell イベントで、自前でデータを描画します。

DrawGrid.RowCount に、検証したいデータ数をセットして下さい。
btnSampleCreateをクリックすると、サンプルデータを作成します。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls{, MMSystem};

type
  PSData = ^TSData;
  TSData = Packed Record
    Index1: Integer;
    Index2: Byte;
    Data1: Byte;
    Data2: Cardinal;
  end;

  TForm1 = class(TForm)
    btnSort: TButton;
    btnSampleCreate: TButton;
    btnSave: TButton;
    btnLoad: TButton;
    btnMLoad: TButton;
    Button1: TButton;
    DrawGrid1: TDrawGrid;
    procedure btnSortClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnSampleCreateClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private 宣言 }
    SDataList: TList;
    procedure DataClear;
    procedure DataLoadfromFile(FileName: String);
    procedure DataSaveToFile(FileName: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
//  Start: integer;

implementation

{$R *.DFM}

function MySort(Item1, Item2: Pointer): Integer;    //２重ソート
begin
  Result := PSdata(Item1)^.Index1 - PSdata(Item2)^.Index1;
  if Result = 0 then
    Result := PSdata(Item1)^.Index2 - PSdata(Item2)^.Index2;
end;

procedure TForm1.btnSortClick(Sender: TObject);
begin
  SDataList.Sort(MySort);
  DrawGrid1.ReFresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SDataList := TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DataClear;
  SDataList.Free;
end;

procedure TForm1.DataClear;
var
  i: integer;
  SData: PSdata;
begin
  for i := 0 to (SDataList.Count - 1) do
  begin
     SData := SDataList.Items[i];
     Dispose(SData);
  end;
  SDataList.Clear;
end;

procedure TForm1.DataLoadfromFile(FileName: String);
var
  F: file of TSData;
  SData: PSdata;
begin
//  Start := TimeGetTime;
  AssignFile(F, FileName);
  ReSet(F);
  while not eof(F) do
  begin
    New(SData);
    Read(F, SData^);
    SDataList.Add(SData);
  end;
  CloseFile(F);
  DrawGrid1.RowCount := SDataList.Count;
  DrawGrid1.ReFresh;
//  ShowMessage(IntToStr(TimeGetTime - Start));
end;

procedure TForm1.DataSaveToFile(FileName: String);
var
  F: file of TSData;
  SData: PSData;
  i: integer;
begin
//  Start := TimeGetTime;
  AssignFile(F, FileName);
  Rewrite(F);
  for i := 0 to SDataList.Count-1 do
  begin
    SData := SDataList.Items[i];
    Write(F, SData^);
  end;
  CloseFile(F);
//  ShowMessage(IntToStr(TimeGetTime - Start));
end;

procedure TForm1.btnSampleCreateClick(Sender: TObject); 
var
  SData: PSdata;
  i: integer;
begin
  DataClear;
  Randomize;
  for i := 0 to DrawGrid1.RowCount-1 do
  begin
    New(SData);
    SData^.Index1 := Random(1000); //
    SData^.Index2 := Random(255);
    SData^.Data1 := 5;
    SData^.Data2 := i;
    SDataList.Add(SData);
  end;
  DrawGrid1.Refresh;
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  SData: PSdata;
begin
  if ARow >= SDataList.Count  then Exit;

  with (Sender as TDrawGrid).Canvas do
  begin
    FillRect(Rect);
    SData := SDataList.Items[ARow];
  //検証用なので、選択時の反転処理などは省いています。
    case ACol of
      0: TextOut(Rect.Left, Rect.Top, IntToStr(SData^.Index1));
      1: TextOut(Rect.Left, Rect.Top, IntToStr(SData^.Index2));
      2: TextOut(Rect.Left, Rect.Top, IntToStr(SData^.Data1));
      3: TextOut(Rect.Left, Rect.Top, IntToStr(SData^.Data2));
    end;
  end;
end;

procedure TForm1.btnSaveClick(Sender: TObject);
begin
  DataSaveToFile('Sample.dat');
end;

procedure TForm1.btnLoadClick(Sender: TObject);
begin
  DataClear;
  DataLoadFromFileM('Sample.dat');
end;

end.
                                     01/09/17(月) 16:22 HATENA(GFC03235)
 


Original document by HATENA          氏 ID:(GFC03235)

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