1行読み込んである変数を基準にしたソートのコードを教えてください (ID：1676)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

TStringList を使わないとすると、固定長データなので、
１行をRecord型の変数に格納するのが常套手段でしょう。
全体のデータの格納先としては、TList か 動的配列 か、になります。
TList は、Sortメソッドを持ってますので、ソートは楽ですが、
ポインタとして扱わなければならないので、インスタンスを作成したり、
解放したりしなければなりません。

どちらも一長一短ですが、
今回のリクエストはソート部は自分でということなので、
動的配列を使ってみました。

標準入出力で、とういうことでしたが、TFileStream にしました。
操作としてはほとんど同じですか、標準入出力では、排他制御が
できませんので、安全性を考慮して TFileStream にしました。

ソートはクイックソートを使いました。TListやTStringListと
同じ手法の比較関数でソートの定義をする手法を使ってます
（やはり使いやすいので）。

ちょっと長くなりますが、ご容赦ください。

unit Unit1;

interface

uses
  Windows, Controls, StdCtrls, Classes, Forms, SysUtils;

type
  TMyRec = Packed Record
    A: Array[1..4] of Char;
    B: Array[1..6] of Char;
    C: Array[1..5] of Char;
    D: Array[1..5] of Char;
    E: Array[1..5] of Char;
    F: Array[1..5] of Char;
    CrLf: Array[1..2] of Char;
  end;
  TMyRecArray = array of TMyRec;

TArraySortCompare = function (Item1, Item2: TMyRec): Integer;

TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FRecArray: TMyRecArray;
    procedure DataLoadFromFile(const FileName: string);
    procedure DataSaveToFile(const FileName: string);
    procedure DataSort(Compare: TArraySortCompare);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DataLoadFromFile(const FileName: string);
var
  FFile:TFileStream;
  Len: integer;
begin
  FFile := TFileStream.Create(FileName, fmOpenRead or fmShareExclusive);
  try
    Len := FFile.Size div SizeOf(TMyRec);
    SetLength(FRecArray, Len);
    FFile.Read(FRecArray[0], SizeOf(TMyRec) * Len);
  finally
    FFile.Free;
  end;
end;

procedure TForm1.DataSaveToFile(const FileName: string);
var
  FFile:TFileStream;
  Len: integer;
begin
  FFile := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    Len := SizeOf(TMyRec) * Length(FRecArray);
    FFile.Write(FRecArray[0], Len);
  finally
    FFile.Free;
  end;
end;

procedure QuickSort(SorTArray: TMyRecArray; L, R: Integer;
  SCompare: TArraySortCompare);
var
  I, J: Integer;
  P, T: TMyRec;
begin
  repeat
    I := L;
    J := R;
    P := SorTArray[(L + R) shr 1];
    repeat
      while SCompare(SorTArray[I], P) < 0 do Inc(I);
      while SCompare(SorTArray[J], P) > 0 do Dec(J);
      if I <= J then
      begin
        T := SorTArray[I];
        SorTArray[I] := SorTArray[J];
        SorTArray[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(SorTArray, L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TForm1.DataSort(Compare: TArraySortCompare);
var
  Len: Integer;
begin
  Len := Length(FRecArray);
  if Assigned(Compare) and (FRecArray <> nil) and (Len > 0) then
    QuickSort(FRecArray, 0, Len - 1, Compare);
end;

function MyCompare(Item1, Item2: TMyRec): Integer;
begin
  Result := CompareStr(Item1.B, Item2.B);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  DataLoadFromFile('FILE1.TXT');
  DataSort(MyComPare);
  DataSaveToFile('FILE2.TXT');
end;

end.

１行目に
  A     B      C    D    E    F
がある場合は、これを読み飛ばす処理を追加する必要があります。

←解決時は質問者本人がここをチェックしてください。

戻る