九宫格数值分组

解答网友问题, 记录如下:

原始数据

11,38
11,36
11,37
11,39
11,40
12,34
12,35
12,36
12,37
12,38
12,40
13,33
13,34
13,35
13,36
13,40
14,32
14,33
14,34
14,35
14,40
15,31
15,32
15,33
15,34
15,40
16,30
16,31
16,32
16,39
17,29
1,1
2,0
2,1
2,3
2,4
3,1

处理代码

unit Unit15;

interface

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

type
  TForm15 = class(TForm)
    btn1: TButton;
    mmo1: TMemo;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form15: TForm15;

implementation

type
  TCustomGroup = class
  private
    type
    TRes = record
      X, Y, Sum : integer;
    end;
    PRes = ^TRes;
  private
    FArr : array of TRes;

    FFileName : string;
    FCount : integer;

    procedure Fill;
    procedure FillRes(const Value : string; ARes : PRes);
    procedure Sort;
    procedure Output(ALst : TStrings);
  public
    constructor Create(const AFileName : string);
    function Exec(ALst : TStrings) : Boolean;
  end;
{$R *.dfm}

procedure TForm15.btn1Click(Sender: TObject);
begin
  mmo1.Clear;

  with TCustomGroup.Create('c:	est.txt') do
  try
    if Exec(mmo1.Lines) then
    begin
      mmo1.SelStart := 0;
      mmo1.SelLength := 0;

      ShowMessage('Ok')
    end
    else
      ShowMessage('Error');
  finally
    Free;
  end;
end;

{ TCustomGroup }

constructor TCustomGroup.Create(const AFileName: string);
begin
  FFileName := AFileName;
end;

function TCustomGroup.Exec(ALst: TStrings): Boolean;
begin
  Result := false;
  try
    Fill;
    Sort;
    Output(ALst);

    Result := True;
  except on E: Exception do
    Result := false;
  end;
end;

procedure TCustomGroup.Fill;
var
  i: Integer;
  sLst : TStringList;
begin
  sLst := TStringList.Create;
  try
    sLst.LoadFromFile(FFileName);

    if sLst.Count < 2 then
      Exit;

    FCount := sLst.Count;
    SetLength(FArr, FCount);

    for i := 0 to sLst.Count - 1 do
    begin
      FillRes(sLst.Strings[i], @FArr[i]);
    end;
  finally
    slst.Free;
  end;
end;

procedure TCustomGroup.FillRes(const Value: string; ARes: PRes);
var
  idx : integer;
begin
  idx := Pos(',', value);
  ARes.X := StrToInt(Copy(Value, 1, idx - 1));
  ARes.Y := StrToInt(Copy(Value, idx + 1, Length(Value)));
  ARes.Sum := ARes.X + ARes.Y;
end;

procedure TCustomGroup.Output(ALst : TStrings);
var
  vRes : TRes;

  procedure Extract(const idx: integer);
  begin
    if (idx < 0) or (idx >= FCount) then
      raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);

    ALst.Add(Format('%d,%d', [FArr[Idx].X, FArr[Idx].Y]));
    Dec(FCount);

    if Idx <> FCount then
    begin
      vRes := FArr[Idx];
      Move(FArr[Idx + 1], FArr[Idx], (FCount - Idx) * SizeOf(TRes));
      FillChar(FArr[FCount], SizeOf(TRes), 0);
    end;
  end;
var
  idx, X, Y : integer;
begin
  repeat
    idx := Low(FArr);
    vRes := FArr[idx];

    while FCount > idx do
    begin
      X := Abs(FArr[idx].x - vRes.x);
      Y := Abs(FArr[idx].y - vRes.y);

      if (X in [0, 1]) and (Y in [0, 1]) then
      begin
        Extract(idx);
      end
      else
      begin
        inc(idx);
      end
    end;
    ALst.Add('');
  until FCount = 0;
end;

procedure TCustomGroup.Sort;
var
  i, j : integer;
  vRes : TRes;
begin
  for i := low(FArr) to High(FArr) - 1 do
  begin
    for j := i + 1 to High(FArr) do
    begin
      if FArr[i].X > FArr[j].X then
      begin
        vRes := FArr[i];
        FArr[i] := FArr[j];
        FArr[j] := vRes;
      end
      else
      if (FArr[i].X = FArr[j].X) and (FArr[i].Y > FArr[j].Y) then
      begin
        vRes := FArr[i];
        FArr[i] := FArr[j];
        FArr[j] := vRes;
      end;
    end;
  end;
end;

end.

处理结果

1,1
2,0
2,1
3,1

2,3
2,4

11,36
11,37
11,38
11,39
11,40
12,40
13,40
14,40
15,40
16,39

12,34
12,35
12,36
12,37
12,38

13,33
13,34
13,35
13,36
14,35
15,34

14,32
14,33
14,34
15,33
16,32

15,31
15,32
16,31

16,30
17,29