absolute borders

{$loadlib pumbaa.dll}

const
  DELAY = 550; // Delay for drawing detected border points.

// V== CODE FOR GENERATING RANDOM SHAPE ==V

procedure TPALine(var TPA:TPointArray; P1, P2: TPoint);
var
  dx,dy,step,I,H: Integer;
  rx,ry,x,y: Extended;
begin
  H := Length(TPA);
  if (p1.x = p2.x) and (p2.y = p1.y) then
  begin
    SetLength(TPA, H+1);
    TPA[H] := P1;
    Exit;
  end;

  dx := (P2.x - P1.x);
  dy := (P2.y - P1.y);
  if (Abs(dx) > Abs(dy)) then step := Abs(dx)
  else step := Abs(dy);
  SetLength(TPA, (H+step+1));

  rx := dx / step;
  ry := dy / step;
  x := P1.x;
  y := P1.y;

  TPA[H] := Point(P1.x, P1.y);
  for I:=1 to step do
  begin
    x := x + rx;
    y := y + ry;
    TPA[(H+i)] := Point(Round(x),Round(y));
  end;
end;

function lines(TPA:TPointArray; Distance:Integer): TPointArray;
var
  i,h,x,y,lx,hx,ly,hy:Integer;
  Matrix:Array of TBoolArray;
  Area: TBox;
  pt:TPoint;

begin
  Area := GetTPABounds(TPA);
  Area.X2 := (Area.X2 - Area.X1) + 1;  //Width
  Area.Y2 := (Area.Y2 - Area.Y1) + 1;  //Height
  H := High(TPA);

  SetLength(Matrix, Area.Y2);
  for i:=0 to (Area.Y2-1) do
    SetLength(Matrix[i], Area.X2);

  for i:=0 to H do
    Matrix[(TPA[i].y-Area.Y1)][(TPA[i].x-Area.X1)] := True;

  for i:=0 to H do
  begin
    pt.x := TPA[i].x-Area.X1;
    pt.y := TPA[i].y-Area.Y1;
    if Matrix[pt.y][pt.x] = True then
    begin
      Matrix[pt.y][pt.x] := False;
      lx := Max(pt.x - Distance, 0);
      hx := Min(pt.x + Distance, Area.X2-1);
      ly := Max(pt.y - Distance, 0);
      hy := Min(pt.y + Distance, Area.Y2-1);
      for x:=lx to hx do
        for y:=ly to hy do
          if Matrix[y][x] = True then
            TPALine(Result, Point((pt.x+Area.X1),(pt.y+Area.y1)), point(x+Area.x1,y+Area.y1));
    end;
  end;
  SetLength(Matrix, 0);
end;

function RandomTPA(Amount:Integer; MinX,MinY,MaxX,MaxY:Integer): TPointArray;
var i:Integer;
begin
  SetLength(Result, Amount);
  for i:=0 to Amount-1 do
    Result[i] := Point(RandomRange(MinX, MaxX), RandomRange(MinY, MaxY));
end;

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;

function BuildShape: TPointArray;
var
  shape: TPointArray;
begin
  shape := RandomTPA(8000, 50,50, 1150,650);
  Result := lines(shape, 10);
end;

// ^== CODE FOR GENERATING RANDOM SHAPE ==^

procedure Test;
var
  TPA: TPointArray;
  t, h, i, bmp: Integer;
begin
  ClearDebug;
  bmp := CreateBitmap(1200, 700);
  DisplayDebugImgWindow(1200, 700);
  //TPA := TPAFromCircle(250, 250, 144);
  TPA := BuildShape;
  DrawTPABitmap(bmp, TPA, 5367616);
  DrawBitmapDebugImg(bmp);
  t := GetSystemTime;
  pp_TPABorders(TPA);
  WriteLn('TPABorder took ' + IntToStr(GetSystemTime - t) + ' ms.');
  h := High(TPA);
  Wait(DELAY);
  DrawTPABitmap(bmp, TPA, 255);
  DrawBitmapDebugImg(bmp);
end;

begin
  Test;
end.