Some usefull TPointArray functions!

[mastaraymond]

Hello,

I made a few (useful) functions.
UPDATE: I updated MostCommonColorBox! And added InArray!


TPoint functions:
Procedure WriteLnTPointArray(ThePoints:TPointArray);
Procedure PointToInt(var x,y:integer; ThePoint:TPoint);
Function TPointArrayToIntegerArray(ThePoints:TPointArray;Re turnX:Boolean): TIntegerArray;
Function GetTPointArrayPeaks(ThePoints:TPointArray; Maximum:boolean): TPoint;
Function TPointArrayToTBox(ThePoints:TPointArray):TBox;
Function BubbleTPointArray(ThePoints:TPointArray; SortOnX,SmallToLarge:boolean):TPointArray;
Function InArray(TheNumber,l:integer;var i:integer;TheArray:TIntegerArray):Boolean;

Color functions:
Function MostCommonColorBox(x1, y1, x2, y2:integer):integer;
Function MostCommonColorSimilarBox(color,tol,x1,y1,x2,y2:in teger):Boolean;
Function MostCommonColor(ThePoints:TPointArray):integer;
Procedure FindColorsSpiralToleranceSaveColors(x,y:Integer;va r Points:TPointArray;var Colors:TIntegerArray;color,xs,ys,xe,ye:Integer;Tol erance:Integer);

I am not able to post more info, because i got to go right now. tomorrow I'll post info, if needed ;).

~Raymond

program New;
var
TempTime:integer;

Procedure WriteLnTPointArray(ThePoints:TPointArray);
var
I:integer;
begin;
For I:= 0 to Length(ThePoints)-1 do
WriteLn('Point['+inttostr(I)+'] ('+inttostr(ThePoints[I].x)+', '+inttostr(ThePoints[I].y)+')');
end;

Procedure PointToInt(var x,y:integer; ThePoint:TPoint);
begin;
x:=ThePoint.x;
y:=ThePoint.y;
end;

Procedure TBoxToInt(Var x1,y1,x2,y2:integer; TheBox:TBox);
begin;
x1:=TheBox.x1;
y1:=TheBox.y1;
x2:=TheBox.x2;
y2:=TheBox.y2;
end;

Function TPointArrayToIntegerArray(ThePoints:TPointArray;Re turnX:Boolean): TIntegerArray;
var
I:integer;
begin;
Try
SetArrayLength(Result,Length(ThePoints));
For I:= 0 to Length(ThePoints)-1 do
If ReturnX then Result[I]:=ThePoints[I].x
else Result[I]:=ThePoints[I].y;
Except
Writeln('There is an error, sorry!');
end;
end;

Function InArray(TheNumber,l:integer;var i:integer;TheArray:TIntegerArray):Boolean;
begin;
For I:=0 to l-1 do
if TheNumber = TheArray[i] then
begin;
Result:=true;
Exit;
end;
end;

Function MostCommonColorBox(x1, y1, x2, y2:integer):integer;
var
XX,YY,I,TempBMP,W,H,Count,TempHandle,L:integer;
TempColors,Temparray: TIntegerArray;
TempStuff: T2DIntArray;
begin
W:= x2-x1;
H:= y2-y1;
TempBMP:= BitmapFromString(w,h,'');
CopyClientToBitmap(TempBMP,x1,y1,x2,y2);
TempHandle:= GetClientWindowHandle;
SetTargetBitmap(TempBMP);
TempStuff:=GetBitmapAreaColors(0,0,w,h);
FreeBitmap(TempBMP);
SetArrayLength(TempColors,0);
SetArrayLength(TempArray,0);
For XX:= 0 to w do
For YY:= 0 to h do
if not InArray(TempStuff[xx][yy],l,i,TempColors) then
begin;
Inc(L);
SetArrayLength(TempColors,L);
TempColors[L-1]:=TempStuff[xx][yy];
SetArrayLength(TempArray,L);
end else
Inc(TempArray[I]);
For I:= 0 to L-1 do
if Count < TempArray[I] then
begin;
Count:=TempArray[I];
Result:=TempColors[I];
end;
SetClientWindowHandle(TempHandle);
end;

Function MostCommonColorSimilarBox(color,tol,x1,y1,x2,y2:in teger):Boolean;
begin;
Result:=SimilarColors(MostCommonColorBox(x1,y1,x2, y2),color,tol);
end;

Function MostCommonColor(ThePoints:TPointArray):integer;
var
TempColors,TempArray: TIntegerArray;
I:integer;
begin;
Try
TempColors:= GetColors(ThePoints);
SetArrayLength(TempArray,Length(TempColors));
For I:= 0 to Length(TempColors)-1 do
For Result:= 0 to Length(TempColors) -1 do
if (TempColors[I] = TempColors[Result]) and not (I=Result) then
begin;
TempArray[I]:=TempArray[I]+1;
Break;
end;
Result := TempColors[AMax(TempArray)];
Except
Writeln('There is an error, sorry!');
end;
end;

Procedure FindColorsSpiralToleranceSaveColors(x,y:Integer;va r Points:TPointArray;var Colors:TIntegerArray;color,xs,ys,xe,ye:Integer;Tol erance:Integer);
begin;
FindColorsSpiralTolerance(x,y,Points,color,xs,ys,x e,ye,Tolerance);
Colors:=GetColors(Points);
end;

Function GetTPointArrayPeaks(ThePoints:TPointArray; Maximum:boolean): TPoint;
var
I:integer;
begin;
if not Maximum then
begin;
Result.x := 764 shl 10;
Result.y := 502 shl 10;
end;
For I:=0 to Length(ThePoints) -1 do
begin;
if Maximum then
begin;
Result.x:= Max(Result.x,ThePoints[I].x);
Result.y:= Max(Result.y,ThePoints[I].y);
end else
begin;
Result.x:= Min(Result.x,ThePoints[I].x);
Result.y:= Min(Result.y,ThePoints[I].y);
end;
end;
end;

Function TPointArrayToTBox(ThePoints:TPointArray):TBox;
var
TempTPoint:TPoint;
begin;
TempTPoint:=GetTPointArrayPeaks(ThePoints,false);
Result.x1:=TempTPoint.x;
Result.y1:=TempTPoint.y;
TempTPoint:=GetTPointArrayPeaks(ThePoints,true);
Result.x2:=TempTPoint.x;
Result.y2:=TempTPoint.y;
end;

Function BubbleTPointArray(ThePoints:TPointArray; SortOnX,SmallToLarge:boolean):TPointArray;
var
I,K:integer;
TempTPointMin,TempTPointMax:TPoint;
begin;
Try
TempTPointMin:=GetTPointArrayPeaks(ThePoints,False );
TempTPointMax:= GetTPointArrayPeaks(ThePoints,True);
SetArrayLength(Result,0);
If SmallToLarge then
begin;
if SortOnX then
begin;
For I:= TempTPointMin.x to TempTPointMax.x do
For K:=0 to Length(ThePoints) -1 do
if (ThePoints[k].x = I) then
begin;
SetArrayLength(Result,Length(Result)+1);
Result[Length(Result)-1].x:=ThePoints[k].x;
Result[Length(Result)-1].y:=ThePoints[k].y;
end;
end else
begin;
For I:= TempTPointMin.y to TempTPointMax.y do
For K:=0 to Length(ThePoints) -1 do
if (ThePoints[k].y = I) then
begin;
SetArrayLength(Result,Length(Result)+1);
Result[Length(Result)-1].x:=ThePoints[k].x;
Result[Length(Result)-1].y:=ThePoints[k].y;
end;
end;
end else
begin;
if SortOnX then
begin;
For I:= TempTPointMax.x Downto TempTPointMin.x do
For K:=0 to Length(ThePoints) -1 do
if (ThePoints[k].x = I) then
begin;
SetArrayLength(Result,Length(Result)+1);
Result[Length(Result)-1].x:=ThePoints[k].x;
Result[Length(Result)-1].y:=ThePoints[k].y;
end;
end else
begin;
For I:= TempTPointMax.y downto TempTPointmin.y do
For K:=0 to Length(ThePoints) -1 do
if (ThePoints[k].y = I) then
begin;
SetArrayLength(Result,Length(Result)+1);
Result[Length(Result)-1].x:=ThePoints[k].x;
Result[Length(Result)-1].y:=ThePoints[k].y;
end;
end;
end;
Except
Writeln('There is an error, sorry!');
end;
end;

begin
TempTime:=GetSystemTime;
Writeln(inttostr(GetSystemTime-TempTime));
end.

[nielsie95]

Nice, looks pretty good :)

[mastaraymond]

Thnx Nielsie,

I made 2 other color functions that are useful if you know how to use them ;)
Function MostCommonColorBox(x1, y1, x2, y2:integer):integer;
Function MostCommonColorSimilarBox(color,tol,x1,y1,x2,y2:in teger):Boolean;
Check upper post!

~Raymond

[WhiteShadow]

Nice functions. :}

[BobboHobbo]

OO nice and confuzing :) (the code)

I like it though good Job

Rep+

[WhiteShadow]

TPointToIntegerArray, looks pretty useless, but then again maybe someone will have a use for it. :p

[mastaraymond]

TPointToIntegerArray, looks pretty useless, but then again maybe someone will have a use for it. :p

I use it to get all the Y's from the TPointArray and then filter those y's :).
EDIT: Updated the functions! Check first post:).
New: InArray!