i need to rearrange an array of array on the length of the arrays, how would i do that?(has to be both from smallest to biggest length)
thanks in advance
i need to rearrange an array of array on the length of the arrays, how would i do that?(has to be both from smallest to biggest length)
thanks in advance
Infractions, reputation, reflection, the dark side of scripting, they are.
SCAR Code:function ReArrangeArrayLength(TheArray: Array of Array of Integer; SmallFirst: Boolean): Array of Array of Integer;
var
Done: Boolean;
ttp: Array of Integer;
tmpTPA: Array of Array of Integer;
c: integer;
begin
SetLength(tmpTPA, Length(TheArray));
tmpTPA:= TheArray;
if SmallFirst then
begin
repeat
done := true;
for c := 0 to (GetArrayLength(TheArray) - 2) do
if Length(tmpTPA[c]) > Length([c + 1]) then
begin
ttp := tmpTPA[c];
tmpTPA[c] := tmpTPA[c + 1];
tmpTPA[c + 1] := ttp;
done := false;
end;
until(done);
SetArrayLength(Result, GetArrayLength(tmpTPA));
Result := tmpTPA;
Exit;
end else
begin
repeat
done := true;
for c := 0 to (GetArrayLength(TheArray) - 2) do
if Length(tmpTPA[c]) < Length([c + 1]) then
begin
ttp := tmpTPA[c];
tmpTPA[c] := tmpTPA[c + 1];
tmpTPA[c + 1] := ttp;
done := false;
end;
until(done);
SetArrayLength(Result, GetArrayLength(tmpTPA));
Result := tmpTPA;
Exit;
end
end;
I think this will do, haven't tested it though![]()
Good Lord...it's by Nielsie anyway.
No need to test.
[CENTER][img]http://signatures.mylivesignature.com/54486/113/4539C8FAAF3EAB109A3CC1811EF0941B.png[/img][/CENTER]
[CENTER][BANANA]TSN ~ Vacation! ~ says :I Love Santy[/BANANA][/CENTER]
[CENTER][BANANA]Raymond - Oh rilie? says :Your smart[/BANANA][/CENTER]
the code
SCAR Code:Procedure RearrangeArrayByLength(var a: Array Of TPointArray; Small: Boolean);
Var
B: Boolean;
L, I: Integer;
Begin
B := True;
L := GetArrayLength(a);
While B Do
Begin
B := False;
For I := 0 To L - 2 Do
If Small Then
Begin
If GetArrayLength(a[i]) > GetArrayLength(a[i+1]) then
Begin
SwapA(a[i], a[i + 1]);
B := True;
End
End
Else
Begin
If GetArrayLength(a[i]) < GetArrayLength(a[i+1]) then
Begin
SwapA(a[i], a[i + 1]);
B := True;
End
End;
End;
End;
test codeSCAR Code:program New;
Procedure SwapA(var a, b :TPointArray);
Var
c: TPointArray;
Begin
c := a;
a := b;
b := c;
End;
Procedure RearrangeArrayByLength(var a: Array Of TPointArray; Small: Boolean);
Var
B: Boolean;
L, I: Integer;
Begin
B := True;
L := GetArrayLength(a);
While B Do
Begin
B := False;
For I := 0 To L - 2 Do
If Small Then
Begin
If GetArrayLength(a[i]) > GetArrayLength(a[i+1]) then
Begin
SwapA(a[i], a[i + 1]);
B := True;
End
End
Else
Begin
If GetArrayLength(a[i]) < GetArrayLength(a[i+1]) then
Begin
SwapA(a[i], a[i + 1]);
B := True;
End
End;
End;
End;
var
a: array of tpointarray;
i: integer;
begin
setarraylength(a, 8);
setarraylength(a[0], 0);
setarraylength(a[1], 7);
setarraylength(a[2], 5);
setarraylength(a[3], 4);
setarraylength(a[4], 0);
setarraylength(a[5], 2);
setarraylength(a[6], 25);
setarraylength(a[7], 6);
RearrangeArrayByLength(a, True);
for i := 0 to getarraylength(a) - 1 do
writeln(inttostr(getarraylength(a[i])));
end.
I guess you didn't see the pastebin link I gave you on msn last night for this ...
SCAR Code:{*******************************************************************************
function RearrangeAOTPAByLength (TheAOTPA:array of array of tpoint; Increasing:boolean):array of array of tpoint;
By: Boreas
Description: Sorts an array of array of tpoint by length of arrays. Increasing=true
makes Result[0] have the smallest array length. Does not touch the tpoints within the arrays.
*******************************************************************************}
function RearrangeAOTPAByLength (TheAOTPA:array of array of tpoint; Increasing:boolean):array of array of tpoint;
var done:boolean;
AL,parray:integer;
ttpa:array of tpoint;
begin
result:=TheAOTPA;
AL:=getarraylength(result);
if Increasing then
begin
repeat
done := True;
for pArray := 0 to (AL - 2) do
begin
if (getarraylength(result[pArray]) > getarraylength(result[pArray + 1])) then
begin
ttpa := result[pArray];
result[pArray] := result[pArray + 1];
result[pArray + 1] := ttpa;
done := False;
end;
end;
until (done);
end;
if not Increasing then
begin
repeat
done := True;
for pArray := 0 to (AL - 2) do
begin
if (getarraylength(result[pArray]) < getarraylength(result[pArray + 1])) then
begin
ttpa := result[pArray];
result[pArray] := result[pArray + 1];
result[pArray + 1] := ttpa;
done := False;
end;
end;
until (done);
end;
end;
nope i didnt... sorry then lol wizzups code is easier to understand though(because swap is a different procedure)
Infractions, reputation, reflection, the dark side of scripting, they are.
Plus it's faster.
There are currently 1 users browsing this thread. (0 members and 1 guests)