-----------------大虾请进,关于数值计算的函数如何写?------------------
本帖最后由 cowbo 于 2013-08-05 22:07:42 编辑
偶有一组数据,是坐标点(图片像索点)的..这些坐标点并不是连续的...(例如下面列表)
现在如何写一个函数,将以下像索点相邻(上,下,左,右)的汇到一个
PList1:array of TStringList;,
就是第一组相连的坐标,按StringList添加按到PList1[0],第二组相连的到PList1[1]........以此类推..
请问如何写?
11,36
11,37
11,38
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
....
[解决办法]
//处理代码
//界面含TMemo(mmo1), button
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;
begin
FCount := Length(FArr);
vRes := FArr[Low(FArr)];
while FCount > 0 do
begin
if Abs(FArr[0].Sum - vRes.Sum) > 2 then
begin
ALst.Add('');
Extract(0);
end
else
if Abs(FArr[0].Sum - vRes.Sum) < 2 then
begin
Extract(0);
end
else
if (Abs(FArr[0].x - vRes.x) = 1) and (Abs(FArr[0].y - vRes.y) = 1) then
begin
Extract(0);
end
else
begin
ALst.Add('');
Extract(0);
end
end;
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.
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
1,1
2,0
2,1
2,3
2,4
3,1
11,36
11,37
11,38
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
