For TPAs if you need it
program New;
{.include SRL/SRL.scar}
var
mytpa,newtpa:array of tpoint;
function RearrangeTPA(thearray:array of tpoint; startpt, endpt:integer; dox,up:boolean):array of tpoint;
var
temp, pArray : integer;
done : boolean;
ttp:tpoint;
tmpTPA : array of tpoint;
begin
setarraylength(tmpTPA,getarraylength(thearray));
tmpTPA:=thearray;
setarraylength(result,endpt+1-startpt);
if not(up) then
begin
if dox then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].x < tmpTPA[pArray + 1].x) then
begin
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
if not(dox) then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].y < tmpTPA[pArray + 1].y) then
begin
ttp := thearray[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
end;
if up then
begin
if dox then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].x > tmpTPA[pArray + 1].x) then
begin
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
if not(dox) then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].y > tmpTPA[pArray + 1].y) then
begin
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
end;
pArray:=startpt-1;
for temp:=0 to getarraylength(result)-1 do
begin
pArray:=pArray+1;
result[temp]:=tmpTPA[pArray];
end;
end;
function tPtArrayToStr(newTPoint: TPointArray): string;
var
i: Integer;
begin
for i:=0 to GetArrayLength(newTPoint)-1 do
begin
Result := Result + IntToStr(newTPoint[i].x) + ',' +
IntToStr(newTPoint[i].y);
if (not (i = (GetArrayLength(newTPoint) - 1))) then
Result := Result + ' ';
end;
end;
function strToTPtArray(tPtStr: string): TPointArray;
var
i, commaPos, spacePos: Integer;
begin
repeat
SetArrayLength(Result, i + 1);
commaPos := Pos(',', tPtStr);
spacePos := Pos(' ', tPtStr);
Result[i].x := StrToInt(Copy(tPtStr, 1, commaPos - 1));
if (not (spacePos = 0)) then
begin
Result[i].y := StrToInt(Copy(tPtStr, commaPos + 1, spacePos - commaPos -
1));
end
else
begin
Result[i].y := StrToInt(Copy(tPtStr, commaPos + 1, Length(tPtStr)));
break;
end;
Delete(tPtStr, 1, spacePos);
i := i + 1;
until (False)
end;
function RemoveDupsFromTPA(var StartTPA: array of Tpoint): array of Tpoint;
var
ArrayLength, pFindDups, pBubbleUp: integer;
tpSwap:tpoint;
begin
ArrayLength:=getarraylength(StartTPA);
result:=RearrangeTPA(StartTPA,0,ArrayLength-1,true,true);
for pFindDups := 0 to (ArrayLength - 2) do
begin
if(result[pFindDups].x = result[pFindDups + 1].x) then
begin
if (result[pFindDups].y = result[pFindDups + 1].y)then
begin
for pBubbleUp := pFindDups to (ArrayLength-2) do
begin
tpSwap := result[pBubbleUp];
result[pBubbleUp] := result[pBubbleUp+1];
result[pBubbleUp+1] := tpSwap;
end;
ArrayLength := ArrayLength-1;
setarraylength(result, ArrayLength);
end;
end;
end;
end;
begin
mytpa:=strToTPtArray('656,62 701,73 645,79 656,62 661,88 621,93 700,110 621,93 653,119');
newtpa:=RemoveDupsFromTPA(mytpa);
writeln(tPtArrayToStr(newtpa));
//newtpa:= RearrangeTPA(mytpa, 0, 1,false,true);
end.