TPACircularity

program New;
{$I SCARExt/SCARExt.scar}

function GetBitmapColorTPA(bmp: TSCARBitmap; color: Integer): TPointArray;
var
  client: TSCARClient;
begin
  client := SetClient(TSCARBitmapClient.Create(bmp));
  FindColorTolEx(Result, 0, 0, 0, (bmp.Width - 1), (bmp.Height - 1),30);
  SetClient(client).Free;
end;


function PolygonArea(TPA:TPointArray): Integer;
var i:Integer;
begin
  Result := 0;
  for i:=0 to High(TPA)-1 do
    Result := Result + (TPA[i].x*TPA[i+1].y) - (TPA[i+1].x*TPA[i].y);
  Result := Round(Abs(0.5 * Result));
end;


function TPACircularity(TPA:TPointArray): Extended;
var
  i,area:Integer;
  Arclen,dist: Extended;
  contour:TPointArray;
begin
  contour := XT_TPAOutline(TPA);
  Area := PolygonArea(contour);
  Arclen := 0;
  for i:=1 to High(contour) do
  begin
    dist := XT_DistEuclidean(contour[i-1],  contour[i]);
    ArcLen := ArcLen + dist;
  end;
  Result := ((PI*4) * Area) / Sqr(ArcLen);
end;


function ATPAFilterCircularity(const ATPA:T2DPointArray; MinCirc:Extended):T2DPointArray;
var
  I,j: Integer;
begin
  j:=0;
  SetLength(Result, Length(ATPA));
  for i:=0 to High(ATPA) do
  begin
    if (TPACircularity(ATPA[i]) >= MinCirc) then
    begin
      WriteLn(TPACircularity(ATPA[i]));
      Result[j] := ATPA[i]
      Inc(j);
    end;
  end;
  SetLength(Result, j);
end;


var
  i: Integer;
  bmp:TSCARBitmap;
  TPA:TPointArray;
  ATPA,ATPA2:T2DPointArray;
begin
  bmp := TSCARBitmap.Create('');
  bmp.loadFromBmp('C:\SCAR Divi\tests\shapes.bmp');
  TPA := GetBitmapColorTPA(bmp, 0);
  ATPA := XT_ClusterTPA(TPA, 1, True);

  ATPA2 := ATPAFilterCircularity(ATPA, 0.1);
  for i:=0 to high(ATPA2) do
    bmp.setpixels(ATPA2[I], 255);
  DebugBitmap(bmp);
end.