Delphi で Rinkaku Application をつくる、の３回目。
今回は、カレントピクセルからの差分をとって輪郭抽出を行う
Contour() をつくる。
C# のここでやった Contour() から作ってみる。
これは、カレントの右上、右横、右下、下の色データの”距離”を
計算して、もっとも遠いものを採用してエッジを検出するものだ。
ご覧のように、少々不気味だ。
一次微分によるエッジ検出は前回の二次微分によるものより、
感度が低い。また、検出されたエッジを表す線も太い。
対応するコード部分を示す。Contour3() として実装した。
uses
VCLImageUtils;
function Contour3(var bmp: TBitmap; Stretch: Boolean = true): Boolean;
const
ix: array[0..3] of integer = (1, 1, 1, 0);
iy: array[0..3] of integer = (-1, 0, 1, 1);
var
tmp: TBitmap;
src: TBmpData24;
dst: TBmpData8;
w, h, x, y, jx, jy, i: integer;
s, t: PRGBTriple;
r: array[0..3] of integer;
d3, max: double;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;
tmp := TBitmap.Create;
tmp.PixelFormat := pf8bit;
tmp.Width := w;
tmp.Height := h;
SetGrayPalette(tmp);
d3 := sqrt(3.0);
src := TBmpData24.Create(bmp);
dst := TBmpData8.Create(tmp);
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
s := src[x,y];
for i := 0 to 3 do
begin
jx := x + ix[i];
jy := y + iy[i];
if ((jx > w -1) or (jy <0) or (jy > h-1)) then
r[i] := 0
else
begin
t := src[jx, jy];
r[i] := (s^.rgbtRed - t^.rgbtRed) * (s^.rgbtRed - t^.rgbtRed) +
(s^.rgbtGreen - t^.rgbtGreen) * (s^.rgbtGreen - t^.rgbtGreen) +
(s^.rgbtBlue - t^.rgbtBlue) * (s^.rgbtBlue - t^.rgbtBlue);
end;
end;
max := 0;
for i := 0 to 3 do if r[i] > max then max := r[i];
dst[x,y]^ := AdjustByte(255 - Sqrt(max) / d3);
end;
dst.Free;
src.Free;
if Stretch then HistoStretch(tmp);
bmp.Free;
bmp := tmp;
result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
if not Assigned(bmp) then exit;
bmp.PixelFormat := pf24bit;
if Contour3(bmp, true) then Canvas.Draw(5, 35, bmp);
bmp.Free;
end;
つぎに、カレントを囲む右側四方向ではなく、８方向全部の距離を
計算して、その最大値をとってエッジを検出してみよう。
こんな感じになる。
わずかながら、前回の Contour3() よりよい結果だと思う。
対応部分のコードを示す。
function Contour4(var bmp: TBitmap; Stretch: Boolean = true): Boolean;
const
ix: array[0..7] of integer = (-1, 0, 1, -1, 1, -1 , 0, 1);
iy: array[0..7] of integer = (-1, -1, -1, 0, 0, 1, 1, 1);
var
tmp: TBitmap;
src: TBmpData24;
dst: TBmpData8;
w, h, x, y, jx, jy, i: integer;
s, t: PRGBTriple;
r: array[0..7] of integer;
d3, max: double;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;
tmp := TBitmap.Create;
tmp.PixelFormat := pf8bit;
tmp.Width := w;
tmp.Height := h;
SetGrayPalette(tmp);
d3 := sqrt(3.0);
src := TBmpData24.Create(bmp);
dst := TBmpData8.Create(tmp);
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
s := src[x,y];
for i := 0 to 7 do
begin
jx := x + ix[i];
jy := y + iy[i];
if ((jx <0) or (jx > w -1) or (jy <0) or (jy > h-1)) then
r[i] := 0
else
begin
t := src[jx, jy];
r[i] := (s^.rgbtRed - t^.rgbtRed) * (s^.rgbtRed - t^.rgbtRed) +
(s^.rgbtGreen - t^.rgbtGreen) * (s^.rgbtGreen - t^.rgbtGreen) +
(s^.rgbtBlue - t^.rgbtBlue) * (s^.rgbtBlue - t^.rgbtBlue);
end;
end;
max := 0;
for i := 0 to 7 do if r[i] > max then max := r[i];
dst[x,y]^ := AdjustByte(255 - Sqrt(max) / d3);
end;
dst.Free;
src.Free;
if Stretch then HistoStretch(tmp);
bmp.Free;
bmp := tmp;
result := true;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
if not Assigned(bmp) then exit;
bmp.PixelFormat := pf24bit;
if Contour4(bmp, true) then Canvas.Draw(5, 35, bmp);
bmp.Free;
end;
さて、一次微分による輪郭抽出でもっとも有名なのは、ここでやった
Sobel フィルタだろう。これを Rinkaku Application 用にしたものを
試してみよう。
こんな感じになる。うーむ、微妙だが、Contour3() や Contour4() より
すこしだけコントラストが良いようだ。
対応部分のコードを示す。
function SobelInvert(var bmp: TBitmap; fGray: Boolean = true):Boolean;
const
hmask: array[-1..1] of array[-1..1] of integer = ((-1,-2,-1),
( 0, 0, 0),
( 1, 2, 1));
vmask: array[-1..1] of array[-1..1] of integer = ((-1, 0, 1),
(-2, 0, 2),
(-1, 0, 1));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
rv, gv, bv, rh, gh, bh: integer;
d2: double;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;
d2 := 1.0 / Sqrt(2.0);
tmp := BmpClone(bmp);
src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);
for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
rv := 0; gv := 0; bv := 0; rh := 0; gh := 0; bh := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];
rv := rv + vmask[x-ix,y-iy]*d^.rgbtRed;
gv := gv + vmask[x-ix,y-iy]*d^.rgbtGreen;
bv := bv + vmask[x-ix,y-iy]*d^.rgbtBlue;
rh := rh + hmask[x-ix,y-iy]*d^.rgbtRed;
gh := gh + hmask[x-ix,y-iy]*d^.rgbtGreen;
bh := bh + hmask[x-ix,y-iy]*d^.rgbtBlue;
end;
d := dst[ix,iy];
d^.rgbtRed := 255 - AdjustByte(sqrt(rv*rv+rh*rh) * d2);
d^.rgbtGreen := 255 - AdjustByte(sqrt(gv*gv+gh*gh) * d2);
d^.rgbtBlue := 255 - AdjustByte(sqrt(bv*bv+bh*bh) * d2);
end;
dst.Free;
src.Free;
tmp.Free;
if fGray then GrayScale(bmp);
HistoStretch(bmp);
result := true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
if not Assigned(bmp) then exit;
bmp.PixelFormat := pf24bit;
if SobelInvert(bmp, true) then Canvas.Draw(5, 35, bmp);
bmp.Free;
end;
今回はこれまで。一次微分用は、以上の三つのうちの一つを採用する
ことになる。
次回は、前回の Edge3() の変形した二次微分のフィルタをつくって
試してみるのと、フィルタの数が多くなってきたので、新たにユニット
ファイルをつくってライブラリとしてまとめる。
アクセス
トータル
