SRL Archive - Test corner

Rawr,
I've been working on a plugin recently and have finally finished it tonight.

So here it is =D.

Creditz to Nielsie for his help, I couldn't of finished it without him ^_^;



Use this script to test it,

var
  Poly1, Mark: Integer;
  Points, Buff: TPointArray;
  
function TBoxToTPA(Box: TBox): TPointArray;
var
  X, Y: Integer;
begin
  for X := Box.X1 to Box.X2 do
    for Y := Box.Y1 to Box.Y2 do
    begin
      SetArrayLength(Result, Length(Result) + 1);
      Result[High(Result)] := IntToPoint(X, Y);
    end;
end;

begin
  SetArrayLength(Points, 9);
  Points[0] := IntToPoint(149, 43);
  Points[1] := IntToPoint(473, 43);
  Points[2] := IntToPoint(609, 265);
  Points[3] := IntToPoint(523, 357);
  Points[4] := IntToPoint(623, 499);
  Points[5] := IntToPoint(490, 388);
  Points[6] := IntToPoint(340, 369);
  Points[7] := IntToPoint(224, 427);
  Points[8] := IntToPoint(74, 338);
  Mark := GetSystemTime;
  Poly1  := Polygon(Points);
  Writeln(IntToStr(GetSystemTime-Mark));
  SetArrayLength(Points, 0);
  Points := TBoxToTPA(PolyBox(Poly1));
  Writeln(IntToStr(GetArrayLength(Points)));
  Mark := GetSystemTime;
    Buff := TPAInPolygon(Poly1, Points);
    Writeln(IntToStr(GetSystemTime-Mark));
  Writeln(IntToStr(GetArrayLength(Buff)));
  FreePolygon(Poly1);
  SetArrayLength(Buff, 0);
  SetArrayLength(Points, 0);
end.

And this one to use Color finding procedures

var
  MyPolygon: Integer;
  Points: TPointArray;

procedure FindColorsPolygonTolerance(var Points: TPointArray; Color, Poly, Tolerance: Integer);
var
  Buffer: TPointArray;
  Box: TBox;
begin
  Box := PolyBox(Poly);
  FindColorsTolerance(Buffer, Color, Box.X1, Box.Y1, Box.X2, Box.Y2, Tolerance);
  Points := TPAInPolygon(Poly, Buffer);
  SetArrayLength(Buffer, 0);
end;

procedure FindColorsPolygon(var Points: TPointArray; Color, Poly: Integer);
begin
  FindColorsPolygonTolerance(Points, Color, Poly, 0);
end;

procedure FindColorsSpiralPolygonTolerance(x, y: Integer; var Points: TPointArray; Color, Poly, Tolerance: Integer);
var
  Buffer: TPointArray;
  Box: TBox;
begin
  Box := PolyBox(Poly);
  FindColorsSpiralTolerance(x, y, Buffer, Color, Box.X1, Box.Y1, Box.X2, Box.Y2, Tolerance);
  Points := TPAInPolygon(Poly, Buffer);
  SetArrayLength(Buffer, 0);
end;

procedure FindColorsSpiralPolygon(x, y: Integer; var Points: TPointArray; Color, Poly: Integer);
begin
  FindColorsSpiralPolygonTolerance(x, y, Points, Color, Poly, 0);
end;

function FindColorPolygonTolerance(var x, y: Integer; Color, Poly, Tolerance: Integer): Boolean;
var
  Buffer: TPointArray;
begin
  FindColorsPolygonTolerance(Buffer, Color, Poly, Tolerance);
  Result := (GetArrayLength(Buffer) > 0);
  if Result then
  begin
    X := Buffer[0].X;
    Y := Buffer[0].Y;
  end;
  SetArrayLength(Buffer, 0);
end;

function FindColorPolygon(var x, y: Integer; Color, Poly: Integer): Boolean;
begin
  Result := FindColorPolygonTolerance(x, y, Color, Poly, 0);
end;

function FindColorSpiralPolygonTolerance(var x, y: Integer; Color, Poly, Tolerance: Integer): Boolean;
var
  Buffer: TPointArray;
begin
  FindColorsSpiralPolygonTolerance(x, y, Buffer, Color, Poly, Tolerance);
  Result := (GetArrayLength(Buffer) > 0);
  if Result then
  begin
    X := Buffer[0].X;
    Y := Buffer[0].Y;
  end;
  SetArrayLength(Buffer, 0);
end;

function FindColorSpiralPolygon(var x, y: Integer; Color, Poly: Integer): Boolean;
begin
  Result := FindColorSpiralPolygonTolerance(x, y, Color, Poly, 0);
end;

begin
  SetArrayLength(Points, 9);
  Points[0] := IntToPoint(149, 43);
  Points[1] := IntToPoint(473, 43);
  Points[2] := IntToPoint(609, 265);
  Points[3] := IntToPoint(523, 357);
  Points[4] := IntToPoint(623, 499);
  Points[5] := IntToPoint(490, 388);
  Points[6] := IntToPoint(340, 369);
  Points[7] := IntToPoint(224, 427);
  Points[8] := IntToPoint(74, 338);
  MyPolygon  := Polygon(Points);
  FreePolygon(MyPolygon);
end.

As you'll tell by the example, It is not 100% perfect, But it's the best I could get it at it's speed.

Also, It does not handle Complex Polygons (Intersecting Points) that great


PS. You'll also need the plugin :P

Rawr..!

Looks niceee! How long did it take you? What is it best at (IE: What in RS) ?

My ub3r C++ will beat j00!


Or not.



Yours is still nice though :p

Leme see, this is where its all about? Also i don't see why you save the polygon in a plugin?

Points := TPAInPolygon(Poly, Buffer);

Nice work though!

~Raymond

*Tear* *Tear*

unce ahts unce ahts unce ahts unce ahts unce ahts! RAVE MUSIC!