SRL Archive - SRL Archives

Inspired by this thread, http://www.villavu.com/forum/showthread.php?t=19832.

function FindColorInPoly(var Points: TPointArray; Color: Integer; Lines: Array of Array of Integer; Tol: Integer): Boolean;
var
  Slope: TPointArray;
  Current, p, y, i, X1, X2, Y1, Y2: Integer;
  Pointss: TPointArray;
  Cross: Array of Array of Boolean;
begin
  SetArrayLength(Slope, GetArrayLength(Lines));
  for i := 0 to GetArrayLength(Lines) - 1 do
  begin
    Slope[i].x := iAbs(Lines[i][0] - Lines[i][2]);
    Slope[i].y := iAbs(Lines[i][1] - Lines[i][3]);
  end;
  for i := 0 to GetArrayLength(Lines) - 1 do
  begin
    if (i = 0) then
    begin
      X1 := Lines[i][0];
      Y1 := Lines[i][1];
      X2 := Lines[i][2];
      Y2 := Lines[i][3];
      i := i + 1;
    end;
    if (Lines[i][0] < X1) then X1 := Lines[i][0];
    if (Lines[i][2] < X1) then X1 := Lines[i][2];
    if (Lines[i][1] < Y1) then Y1 := Lines[i][1];
    if (Lines[i][3] < Y1) then Y1 := Lines[i][3];
    if (Lines[i][2] > X2) then X2 := Lines[i][2];
    if (Lines[i][0] > X2) then X2 := Lines[i][0];
    if (Lines[i][3] > Y2) then Y2 := Lines[i][3];
    if (Lines[i][1] > Y2) then Y2 := Lines[i][1];
  end;
  // WriteLN('X1: ' + IntToStr(X1) + ' Y1: ' + IntToStr(Y1) + ' X2: ' + IntToStr(X2) + ' Y2: ' + IntToStr(Y2));
  FindColorsTolerance(Pointss, Color, X1, Y1, X2, Y2, Tol);
  // WriteLN(IntToStr(GetArrayLength(Pointss)));
  if (GetArrayLength(Pointss) = 0) then Exit;
  // WriteLN('');
  SetArrayLength(Cross, GetArrayLength(Pointss));
  for p := 0 to GetArrayLength(Cross) - 1 do
    SetArrayLength(Cross[p], GetArrayLength(Lines));
  for p := 0 to GetArrayLength(Pointss) - 1 do
  begin
    for i := 0 to GetArrayLength(Lines) - 1 do
    begin
      if (Pointss[p].y > Lines[i][1]) and (Pointss[p].y > Lines[i][3]) and ((not (Pointss[p].x > Lines[i][0]) and (Pointss[p].x > Lines[i][2]))) or ((not (Pointss[p].x < Lines[i][0]) and (Pointss[p].x < Lines[i][2]))) then
      begin
        Cross[p][i] := True;
      end else
      begin
        if (Pointss[p].y > Lines[i][1]) or (Pointss[p].y > Lines[i][3]) then
        begin
          try
            if (Lines[i][1] > Lines[i][3]) then y := ((Lines[i][1] - Pointss[i].y) / Slope[i].y)
              else y := ((Lines[i][3] - Pointss[i].y) / Slope[i].y);
          except
            end;
          if (Lines[i][0] < Lines[i][2]) then
          begin
            if (Lines[i][0] + (Slope[i].x * y) = Pointss[p].x) then
            begin
              Cross[p][i] := True;
            end;
          end else
          begin
            if (Lines[i][2] + (Slope[i].x * y) = Pointss[p].x) then
            begin
              Cross[p][i] := True;
            end;
          end;
        end;
      end;
    end;
  end;
  for p := 0 to GetArrayLength(Pointss) - 1 do
  begin
    for i := 0 to GetArrayLength(Lines) - 1 do
      if (Cross[p][i]) then Current := Current + 1;
    // WriteLN(IntToStr(Current));
    if (Current mod 2 <> 0) then
    begin
      SetArrayLength(Points, GetArrayLength(Points) + 1);
      Points[GetArrayLength(Points) - 1]  := Pointss[p];
    end;
    Current := 0;
  end;
  if (GetArrayLength(Points) > 0) then Result := True;
end;

Returns the coordinates as TPoints. The lines should be entered like this:

var Lines: Array[0..2] of Array of Integer;
Lines[0] := [199, 81, 320, 92];
Lines[1] := [320, 92, 197, 101];
Lines[2] := [197, 101, 199, 81];
FindColorInPoly(Points, 5000376, Lines, 1);

Set the number of sides when declaring the variable. Declare each line in the polygon as 4 points, the end points of the line. Since polygons have each line connected to the next line by a point you will notice that the last coordinate and the first coordinate of the next one are the same.

This works with triangles, quadralaterals (sp?), pentagons, hexagons, etc. If you enter less than three sides then it won't work. Two may actually work, but you can just use FindColor() if you want to do that.

If you are trying to figure out how I made this function, read this: http://en.wikipedia.org/wiki/Point_in_polygon.

If you have any questions I should be able to answer them.

– I just noticed it's broken again :/

Swoot Job Town. Yet another impressive piece of code (Not that I can understand it).

Hmmm… I swear I've seen this before… ;)

Good job Town, It does work for what I'm trying to do also, so double Kudo's to you!

The only suggestion I have is that you should make it so that you only need to enter the TPoint of the Vertex and then have the function calculate the lines itself. Maybe just make it work from TPoint[1] -> TPoint[2] = Line[1], TPoint[2] -> TPoint[3] = Line[2], ect… and just make a warning or something saying that points must be in linear order, or in a continuous order. Something along those lines.

Special Ed is always asking for really hard stuff :p

Good job Town!

Looks really cool, i still don't see where you could use it for though ^^.

Ehhh… Its just that I tend to get stumped when it comes to relatively easy, or I try to make something simple very, very complex. It's a disease me and my brother both live with, :D

Either way, I think you should try making it into a plugin as well, that would decrease lag and allow you to use more points without having to sacrifice so much memory when running it.

Odd…. I was making one of these in C++ :)