简介
一种简单的边界分析，通过相邻的像素的灰度进行判断，计算出边界。
测试1
原图
结果
测试2
原图
结果
代码说明
主要的技术在makeTable过程中，这个过程主要执行了以下几步
- 计算每个像素的灰度
- 计算相邻多个像素的最大灰度差
- 统计灰度差，计算出阈值
- 根据阈值，计算出边界，并标注在图像上
procedure makeTable(img: TBitmap32);
var
w, h, w_r, h_r, x, y, k, r_count, Pcount: Integer;
bmp2, bmp: TBitmap32;
blist: TByteTable;
blist_diff: TByteTable;
b, b1, b2, maxa: byte;
c32: TColor32Entry;
sum, stepCount, count: integer;
idx, i, j, s_x_1, s_x_2: integer;
s_y_1, s_y_2: integer;
c_b: array[0..255] of integer;
FilterB: Byte;
Filter_Count: integer;
Filter_Sum: integer;
RectList: array of array of TRectRec;
r: Trect;
pt_1, path: array of TPoint;
fillcount, maxfillcount: integer;
function check_r(i, j: integer; pt: array of TPoint): Boolean;
var
idx: integer;
begin
Result := false;
if RectList[i, j].count <= 0 then
exit;
for idx := 0 to high(pt) do
begin
if RectList[i + pt[idx].X, j + pt[idx].y].count > 0 then
begin
Result := false;
Exit;
end;
end;
Result := true;
end;
procedure getFill(x, y: integer; pt: array of TPoint; MaxCount: integer; var path: array of TPoint; var count: integer);
var
idx: integer;
ax, ay: integer;
begin
if x < 0 then
Exit;
if y < 0 then
Exit;
if x >= w_r then
Exit;
if y >= h_r then
Exit;
if RectList[x, y].count <= 0 then
Exit;
if count >= MaxCount then
exit;
for idx := count - 1 downto 0 do
begin
if (path[idx].X = x) and (path[idx].y = y) then
begin
Exit;
end;
end;
path[count] := Point(x, y);
inc(count);
if count >= MaxCount then
exit;
for idx := 0 to high(pt) do
begin
ax := x + pt[idx].X;
ay := y + pt[idx].Y;
getFill(ax, ay, pt, MaxCount, path, count);
end;
end;
begin
w := img.Width;
h := img.Height;
SetLength(blist, w);
for x := 0 to w - 1 do
SetLength(blist[x], h);
SetLength(blist_diff, w);
for x := 0 to w - 1 do
SetLength(blist_diff[x], h);
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
c32.ARGB := img.Pixel[x, y];
b := (77 * c32.R + 150 * c32.G + 29 * c32.B) shr 8;
blist[x, y] := b;
end;
bmp2 := TBitmap32.Create;
bmp2.SetSize(w, h);
maxa := 0;
stepCount := 5;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
count := min(x - 0 + 1, stepCount);
s_x_1 := getsum(blist, x, y, -1, 0, count);
count := min(w - x, stepCount);
s_x_2 := getsum(blist, x, y, 1, 0, count);
count := min(y - 0 + 1, stepCount);
s_y_1 := getsum(blist, x, y, 0, -1, count);
count := min(h - y, stepCount);
s_y_2 := getsum(blist, x, y, 0, 1, count);
b := max(abs(s_x_1 - s_x_2), abs(s_y_1 - s_y_2));
blist_diff[x, y] := b;
if b > maxa then
maxa := b;
end;
ZeroMemory(@(c_b[0]), length(c_b) * sizeof(i));
Pcount := 0;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
b := blist_diff[x, y];
b := 255 * b div maxa;
blist_diff[x, y] := b;
inc(c_b[b]);
inc(Pcount);
end;
FilterB := 0;
count := 0;
for i := 0 to 255 do
begin
inc(count, c_b[i]);
if count > (Pcount div 2) then
begin
FilterB := i ;
Break;
end
end;
Pcount := 0;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
if blist_diff[x, y] < FilterB then
blist_diff[x, y] := 0;
end;
x := 0;
y := 0;
r_count := 10;
w_r := (w - 1) div r_count + 1;
h_r := (h - 1) div r_count + 1;
SetLength(RectList, w_r);
for x := 0 to w_r - 1 do
SetLength(RectList[x], h_r);
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
x := (i) * r_count;
y := (j) * r_count;
r.Left := x;
r.Top := y;
r.Right := Min(x + r_count, w);
r.Bottom := Min(y + r_count, h);
RectList[i, j].rect := r;
RectList[i, j].sum := 0;
RectList[i, j].count := 0;
end;
count := 0;
sum := 0;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
b := blist_diff[x, y];
if b = 0 then
Continue;
i := x div (r_count);
j := y div (r_count);
inc(RectList[i, j].sum, b);
inc(RectList[i, j].count);
inc(sum, b);
inc(count);
end;
Filter_Sum := sum div count;
Filter_Count := max(r_count, count div (w_r * h_r));
setlength(pt_1, 8);
pt_1[0] := Point(-1, -1);
pt_1[1] := Point(0, -1);
pt_1[2] := Point(+1, -1);
pt_1[3] := Point(-1, 0);
pt_1[4] := Point(+1, 0);
pt_1[5] := Point(-1, +1);
pt_1[6] := Point(0, +1);
pt_1[7] := Point(-1, +1);
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
if RectList[i, j].count < Filter_Count then
begin
RectList[i, j].count := 0
end
else
begin
if RectList[i, j].sum < (Filter_Sum * RectList[i, j].count) then
begin
RectList[i, j].count := 0;
end;
end;
end;
setlength(path, 255);
maxfillcount := 50;
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
fillcount := 0;
getFill(i, j, pt_1, maxfillcount + 1, path, fillcount);
if fillcount <= maxfillcount then
begin
for idx := 0 to fillcount - 1 do
begin
RectList[path[idx].X, path[idx].y].count := 0;
end;
end;
end;
setlength(pt_1, 0);
setlength(path, 0);
Pcount := 0;
for x := 1 to w - 2 do
for y := 1 to h - 2 do
begin
if blist_diff[x, y] > 0 then
inc(Pcount);
end;
c32.ARGB := clRed32;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
i := x div (r_count);
j := y div (r_count);
if RectList[i, j].count > 0 then
c32.A := blist_diff[x, y]
else
c32.A := 0;
bmp2.Pixel[x, y] := c32.ARGB;
end;
bmp2.DrawMode := dmBlend;
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
if RectList[i, j].count > 0 then
img.FrameRectS(RectList[i, j].rect, clBlue32);
end;
img.Draw(0, 0, bmp2);
FreeAndNil(bmp2);
for x := 0 to w - 1 do
SetLength(blist[x], 0);
SetLength(blist, 0);
for x := 0 to w - 1 do
SetLength(blist_diff[x], 0);
SetLength(blist_diff, 0);
for x := 0 to w_r - 1 do
SetLength(RectList[x], 0);
setlength(RectList, 0);
end;
完整代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, gr32, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Panel1: TPanel;
Image1: TImage;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses math;
type
TByteTable = array of array of Byte;
TRectRec = record
rect: TRect;
b: Byte;
sum: integer;
count: integer;
end;
function getsum(table: TByteTable; ax, ay, ix, iy, count: integer): integer;
var
i, x, y: integer;
begin
Result := 0;
x := ax;
y := ay;
for i := 1 to count do
begin
inc(Result, table[x, y]);
inc(x, ix);
inc(y, iy);
end;
Result := Result div count;
end;
procedure makeTable(img: TBitmap32);
var
w, h, w_r, h_r, x, y, k, r_count, Pcount: Integer;
bmp2, bmp: TBitmap32;
blist: TByteTable;
blist_diff: TByteTable;
b, b1, b2, maxa: byte;
c32: TColor32Entry;
sum, stepCount, count: integer;
idx, i, j, s_x_1, s_x_2: integer;
s_y_1, s_y_2: integer;
c_b: array[0..255] of integer;
FilterB: Byte;
Filter_Count: integer;
Filter_Sum: integer;
RectList: array of array of TRectRec;
r: Trect;
pt_1, path: array of TPoint;
fillcount, maxfillcount: integer;
function check_r(i, j: integer; pt: array of TPoint): Boolean;
var
idx: integer;
begin
Result := false;
if RectList[i, j].count <= 0 then
exit;
for idx := 0 to high(pt) do
begin
if RectList[i + pt[idx].X, j + pt[idx].y].count > 0 then
begin
Result := false;
Exit;
end;
end;
Result := true;
end;
procedure getFill(x, y: integer; pt: array of TPoint; MaxCount: integer; var path: array of TPoint; var count: integer);
var
idx: integer;
ax, ay: integer;
begin
if x < 0 then
Exit;
if y < 0 then
Exit;
if x >= w_r then
Exit;
if y >= h_r then
Exit;
if RectList[x, y].count <= 0 then
Exit;
if count >= MaxCount then
exit;
for idx := count - 1 downto 0 do
begin
if (path[idx].X = x) and (path[idx].y = y) then
begin
Exit;
end;
end;
path[count] := Point(x, y);
inc(count);
if count >= MaxCount then
exit;
for idx := 0 to high(pt) do
begin
ax := x + pt[idx].X;
ay := y + pt[idx].Y;
getFill(ax, ay, pt, MaxCount, path, count);
end;
end;
begin
w := img.Width;
h := img.Height;
SetLength(blist, w);
for x := 0 to w - 1 do
SetLength(blist[x], h);
SetLength(blist_diff, w);
for x := 0 to w - 1 do
SetLength(blist_diff[x], h);
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
c32.ARGB := img.Pixel[x, y];
b := (77 * c32.R + 150 * c32.G + 29 * c32.B) shr 8;
blist[x, y] := b;
end;
bmp2 := TBitmap32.Create;
bmp2.SetSize(w, h);
maxa := 0;
stepCount := 5;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
count := min(x - 0 + 1, stepCount);
s_x_1 := getsum(blist, x, y, -1, 0, count);
count := min(w - x, stepCount);
s_x_2 := getsum(blist, x, y, 1, 0, count);
count := min(y - 0 + 1, stepCount);
s_y_1 := getsum(blist, x, y, 0, -1, count);
count := min(h - y, stepCount);
s_y_2 := getsum(blist, x, y, 0, 1, count);
b := max(abs(s_x_1 - s_x_2), abs(s_y_1 - s_y_2));
blist_diff[x, y] := b;
if b > maxa then
maxa := b;
end;
ZeroMemory(@(c_b[0]), length(c_b) * sizeof(i));
Pcount := 0;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
b := blist_diff[x, y];
b := 255 * b div maxa;
blist_diff[x, y] := b;
inc(c_b[b]);
inc(Pcount);
end;
FilterB := 0;
count := 0;
for i := 0 to 255 do
begin
inc(count, c_b[i]);
if count > (Pcount div 2) then
begin
FilterB := i ;
Break;
end
end;
Pcount := 0;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
if blist_diff[x, y] < FilterB then
blist_diff[x, y] := 0;
end;
x := 0;
y := 0;
r_count := 10;
w_r := (w - 1) div r_count + 1;
h_r := (h - 1) div r_count + 1;
SetLength(RectList, w_r);
for x := 0 to w_r - 1 do
SetLength(RectList[x], h_r);
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
x := (i) * r_count;
y := (j) * r_count;
r.Left := x;
r.Top := y;
r.Right := Min(x + r_count, w);
r.Bottom := Min(y + r_count, h);
RectList[i, j].rect := r;
RectList[i, j].sum := 0;
RectList[i, j].count := 0;
end;
count := 0;
sum := 0;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
b := blist_diff[x, y];
if b = 0 then
Continue;
i := x div (r_count);
j := y div (r_count);
inc(RectList[i, j].sum, b);
inc(RectList[i, j].count);
inc(sum, b);
inc(count);
end;
Filter_Sum := sum div count;
Filter_Count := max(r_count, count div (w_r * h_r));
setlength(pt_1, 8);
pt_1[0] := Point(-1, -1);
pt_1[1] := Point(0, -1);
pt_1[2] := Point(+1, -1);
pt_1[3] := Point(-1, 0);
pt_1[4] := Point(+1, 0);
pt_1[5] := Point(-1, +1);
pt_1[6] := Point(0, +1);
pt_1[7] := Point(-1, +1);
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
if RectList[i, j].count < Filter_Count then
begin
RectList[i, j].count := 0
end
else
begin
if RectList[i, j].sum < (Filter_Sum * RectList[i, j].count) then
begin
RectList[i, j].count := 0;
end;
end;
end;
setlength(path, 255);
maxfillcount := 50;
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
fillcount := 0;
getFill(i, j, pt_1, maxfillcount + 1, path, fillcount);
if fillcount <= maxfillcount then
begin
for idx := 0 to fillcount - 1 do
begin
RectList[path[idx].X, path[idx].y].count := 0;
end;
end;
end;
setlength(pt_1, 0);
setlength(path, 0);
Pcount := 0;
for x := 1 to w - 2 do
for y := 1 to h - 2 do
begin
if blist_diff[x, y] > 0 then
inc(Pcount);
end;
c32.ARGB := clRed32;
for x := 0 to w - 1 do
for y := 0 to h - 1 do
begin
i := x div (r_count);
j := y div (r_count);
if RectList[i, j].count > 0 then
c32.A := blist_diff[x, y]
else
c32.A := 0;
bmp2.Pixel[x, y] := c32.ARGB;
end;
bmp2.DrawMode := dmBlend;
for i := 0 to w_r - 1 do
for j := 0 to h_r - 1 do
begin
if RectList[i, j].count > 0 then
img.FrameRectS(RectList[i, j].rect, clBlue32);
end;
img.Draw(0, 0, bmp2);
FreeAndNil(bmp2);
for x := 0 to w - 1 do
SetLength(blist[x], 0);
SetLength(blist, 0);
for x := 0 to w - 1 do
SetLength(blist_diff[x], 0);
SetLength(blist_diff, 0);
for x := 0 to w_r - 1 do
SetLength(RectList[x], 0);
setlength(RectList, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
fn: string;
bmp: TBitmap32;
begin
fn := ExtractFilePath(Application.ExeName) + 'IMG_0023.JPG';
bmp := TBitmap32.Create;
bmp.LoadFromFile(fn);
fn := fn + '.bmp';
makeTable(bmp);
bmp.SaveToFile(fn);
Image1.Picture.LoadFromFile(fn);
end;
end.
