九宫格数值分组

最新推荐文章于 2023-02-10 22:48:30 发布

原创最新推荐文章于 2023-02-10 22:48:30 发布 · 2k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#九宫格 #delphi #相邻数值分组

Delphi 专栏收录该内容

58 篇文章

订阅专栏

本文介绍了一种数据处理方法，该方法通过读取文件中的原始数据进行特定的排序和筛选操作，最终输出处理后的结果。处理过程中涉及到了数据结构的设计、排序算法的应用以及异常处理等内容。

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

原始数据

处理代码

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:\test.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.

处理结果