function killsmallareas(bmp : TBitmap) : TBitmap;
var i, j, k, l : integer;
Polygones :
array of array of TPoint;
found : boolean;
Begin
result := TBitmap.Create;
result.Width := bmp.Width;
result.Height := bmp.Height;
result.PixelFormat := bmp.PixelFormat;
SetLength(polygones, 1, 1);
for i := 0
to bmp.Width - 1
do
for j := 0
to bmp.Height - 1
do
Begin
if bmp.Canvas.Pixels[i, j] = clblack
then Begin
with bmp.Canvas
do
Begin
if (Pixels[i-1, j] = clblack)
or (Pixels[i-1, j-1] = clblack)
or (Pixels[i, j-1] = clblack)
or (Pixels[i+1, j-1] = clblack)
or (Pixels[i+1, j] = clblack)
or (Pixels[i+1, j+1] = clblack)
or (Pixels[i, j+1] = clblack)
or (Pixels[i-1, j+1] = clblack)
then Begin
k := 0;
found := false;
while ( k < high(polygones))
and (found = false)
do
Begin
l := 0;
while ( l < high(polygones[k]))
and (
not(PointsEqual(polygones[k, l], Point(i-1, j)))
or not(PointsEqual(polygones[k, l], Point(i-1, j-1)))
or not(PointsEqual(polygones[k, l], Point(i, j-1)))
or not(PointsEqual(polygones[k, l], Point(i+1, j-1)))
or not(PointsEqual(polygones[k, l], Point(i+1, j)))
or not(PointsEqual(polygones[k, l], Point(i+1, j+1)))
or not(PointsEqual(polygones[k, l], Point(i, j+1)))
or not(PointsEqual(polygones[k, l], Point(i-1, j+1))) )
do inc(l);
if l < high(polygones[k])
then found := true;
inc(k);
end;
if found
then Begin
dec(k);
SetLength(polygones[k], high(polygones[k])+1);
polygones[k, high(polygones[k])] := Point(i, j);
end
else Begin
setlength(polygones, high(polygones)+1);
setlength(polygones[high(polygones)], 1);
polygones[high(polygones), 0] := Point(i, j);
end;
end;
end;
end;
end;
for k := 0
to High(polygones)
do
if high(polygones[k]) > 100
then for l := 0
to high(polygones[k])
do
result.Canvas.Pixels[polygones[k, l].X, polygones[k, l].Y] := clblack;
end;