procedure TPAEdge(var TPA: TPointArray);
var
  v, x, y, h, r: Integer;
  B: array of TBoolArray;
  bx: TBox;
begin;
  h := High(TPA);
  if (h > 3) then
  begin
    bx := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
    if (h > 0) then
    for v := 1 to h do
    begin
      if (TPA[v].X < bx.X1) then
        bx.X1 := TPA[v].X
      else
        if (TPA[v].X > bx.X2) then
          bx.X2 := TPA[v].X;
      if (TPA[v].Y < bx.Y1) then
        bx.Y1 := TPA[v].Y
      else
        if (TPA[v].Y > bx.Y2) then
          bx.Y2 := TPA[v].Y;
    end;
    bx := IntToBox((bx.X1 - 1), (bx.Y1 - 1), (bx.X2 + 1), (bx.Y2 + 1));
    SetLength(B, ((bx.X2 - bx.X1) + 1));
    for v := 0 to (bx.X2 - bx.X1) do
      SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
    for v := 0 to h do
      if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
        B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
    for y := 1 to ((bx.Y2 - bx.Y1) - 1) do
      for x := 1 to ((bx.X2 - bx.X1) - 1) do
        if B[x][y] then
          if not (B[(x - 1)][y] and B[x][(y - 1)] and B[(x + 1)][y] and B[x][(y + 1)]) then
          begin
            TPA[r].X := (x + bx.X1);
            TPA[r].Y := (y + bx.Y1);
            Inc(r);
          end;
    SetLength(TPA, r);
    SetLength(B, 0);
  end;
end;

{------------------------------------------------------------------------------]
 Check if a point is within a polygon/shape by the given outline points (poly)
 The points must be in order, as if you would draw a line trough each point.
[------------------------------------------------------------------------------}
function InPoly(pt:TPoint; poly:TPointArray): Boolean;
var
  N,I, xint: Integer;
  p1,p2: TPoint;
  g: Boolean;
  e: TPointArray;
begin
  N := Length(poly);
  Result := False;
  if N>2 then
  begin
    e := CopyTPA(poly);
    WriteLn('BEFORE: ' + ToStr(e));
    TPAEdge(e);
    WriteLn('AFTER: ' + ToStr(e));
    p1 := poly[0];
    for I:=0 to N do
    begin
      p2 := poly[I mod N];
      g := PointInTPA(pt, e);
      if (g or (pt.y > min(p1.y,p2.y)))  and
         (g or (pt.y <= max(p1.y,p2.y))) and
         (g or (pt.x <= max(p1.x,p2.x))) then
      begin
        if not g then
          if (p1.y <> p2.y) then
            xint := (pt.y - p1.y) * (p2.x - p1.x) div (p2.y - p1.y) + p1.x;
        if (g or ((p1.x = p2.x) or (pt.x < xint))) then
          Result := Not(Result);
      end;
      p1 := p2;
    end;
  end;
end;

//******* DIRTY EXAMPLE BELLOW: *******//
procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
var
  a, z, w, h: Integer;
begin
  z := High(TPA);
  if (z > -1) then
  begin
    GetBitmapSize(bmp, w, h);
    for a := 0 to z do
      if ((TPA[a].X >= 0) and (TPA[a].Y >= 0) and (TPA[a].X < w) and (TPA[a].Y < h)) then
        FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  end;
end;

procedure SetPixelsMP(bmp: Integer; TPA: TPointArray; color: Integer);
var
  a, z, w, h: Integer;
begin
  z := High(TPA);
  if (z > -1) then
  begin
    GetBitmapSize(bmp, w, h);
    for a := 0 to z do
      if ((TPA[a].X > 0) and (TPA[a].Y > 0) and (TPA[a].X < w-1) and (TPA[a].Y < h-1)) then
      begin
        FastSetPixel(bmp, TPA[a].X-1, TPA[a].Y, color);
        FastSetPixel(bmp, TPA[a].X+1, TPA[a].Y, color);
        FastSetPixel(bmp, TPA[a].X, TPA[a].Y+1, color);
        FastSetPixel(bmp, TPA[a].X, TPA[a].Y-1, color);
      end;
  end;
end;

function FillShape(shape: TPointArray): TPointArray;
var
  z: TBox;
  x, y, r, l, i, n, c: Integer;
  a, b: TPoint;
  v, g: Boolean;
  p: TPoint;
  e: TPointArray;
begin
  l := Length(shape);
  if (l > 2) then
  begin
    z := IntToBox(shape[0].X, shape[0].Y, shape[0].X, shape[0].Y);
    if (l > 1) then
    for i := 1 to (l - 1) do
    begin
      if (shape[i].X < z.X1) then
        z.X1 := shape[i].X
      else
        if (shape[i].X > z.X2) then
          z.X2 := shape[i].X;
      if (shape[i].Y < z.Y1) then
        z.Y1 := shape[i].Y
      else
        if (shape[i].Y > z.Y2) then
          z.Y2 := shape[i].Y;
    end;
    e := CopyTPA(shape);
    TPAEdge(e);
    SetLength(Result, (((z.X1 * z.X2) + 1) * ((z.Y1 * z.Y2) + 1)));
    n := Length(Result);
    if (n > 0) then
    begin
      for y := z.y1 to z.y2 do
        for x := z.x1 to z.x2 do
        begin
          p := Point(x, y);
          v := False;
          a := shape[0];
          v := PointInTPA(p, e);
          if not v then
          for i := 0 to l do
          begin
            b := shape[Round(i mod l)];
            if ((p.y > Min(a.y, b.y)) and (p.y <= Max(a.y, b.y)) and (p.x <= Max(a.x, b.x))) then
            begin
              if (a.y <> b.y) then
                c := ((p.y - a.y) * (b.x - a.x) div (b.y - a.y) + a.x);
              if ((a.x = b.x) or (p.x <= c)) then
              v := not v;
            end;
            a := b;
          end;
          if v then
          begin
            Result[r] := Point(x, y);
            Inc(r);
          end;
        end;
      SetLength(Result, r);
    end;
  end else
    SetLength(Result, 0);
end;

function Xagon(Sides:Integer;C,S:TPoint): TPointArray;
var
  ptx,pty,dx,dy,i: Integer;
  rads:Extended;
begin
  SetLength(Result,Sides+1);
  ptx := S.x;
  pty := S.y;
  rads := Radians(360/sides);
  for i:=0 to Sides do
  begin
    dx := ptx - c.x;
    dy := pty - c.y;
    ptx := Round((dy * Sin(rads)) + (dx * Cos(rads)) + c.x);
    pty := Round((dy * Cos(rads)) - (dx * Sin(rads)) + c.y);
    Result[i] := Point(ptx,pty);
  end;
end;

//******* Plot a few shapes using this algorithm *******//
var
  Shape, TPA: TPointArray;
  bmp: Integer;
  ShowExample,ShowPoints: Integer;
begin
  //Dynamic shapes from Example 6 and down:
  ShowExample := 0; //1 - 9
  ShowPoints := 0;  //0 or 1

  Case ShowExample of
  0: Shape := [Point(50, 50), Point(51, 50), Point(51, 50), Point(51, 51)];
  1: // Manual: Arrow like shape //
     Shape := [Point(70,90),Point(185,90),Point(185,116), Point(70,116), //Square +
               Point(70,140),Point(35,105),Point(70,70)];                //Triangle

  2: // Manual: Triangle //
     Shape := [Point(50,50),Point(0,100),Point(100,150)];

  3: // Manual: Raped pentagon //
     Shape := [Point(10,25),Point(35,5),Point(82,22),Point(50,90),Point(4,60)];

  4: // Manual: Octagon //
     Shape := [Point(100,30), Point(155,50),  //Top-Right
               Point(180,110),Point(155,160), //Right-Bottom
               Point(100,180),Point(45,160),  //Bottom-Left
               Point(20,100), Point(45,50)];  //Left-Top

  5: // Manual: S-Shape //
     Shape := [Point(135,50),Point(123,70),Point(103,58),Point(85,70),Point(85,85),
                Point(122,105),Point(132,125),Point(120,155),Point(78,164),Point(55,147),
                Point(64,128),Point(80,140),Point(100,140),Point(96,116),Point(62,98),
                Point(60,55),Point(111,35)];

  6: // Xagon: 15 corners //
     Shape := Xagon(15, Point(100,100), Point(60,100));

  7: // Xagon: 9 corners //
     Shape := Xagon(9, Point(100,100), Point(60,50));

  8: // Xagon: 5 corners AKA Pentagon //
     Shape := Xagon(5, Point(100,100), Point(75,50));

  9: // Xagon: 3 corners AKA Triangle //
     Shape := Xagon(3, Point(100,100), Point(48,48));
  end;

  bmp := CreateBitmap(200, 200);
  TPA := FillShape(Shape);
  //TPAEdge(TPA);
  SetPixels(bmp, TPA, 357435);
  if ShowPoints=1 then
    SetPixelsMP(bmp, Shape, 16777215);
  DisplayDebugImgWindow(200, 200);
  DrawBitmapDebugImg(bmp);
  FreeBitmap(bmp);
end.