なんとなく、ふわっと・・

写真と画像処理関係とひとりごとをなんとなく書き溜めていきたい

Delphi で SmoothEdge

2007-12-19 20:22:30 | Delphi


C# でやったように、マスクを作って切り抜き、貼り付けをおこなう Crop SmoothEdge および
SetAlpha32 に相当する関数を Delphi でつくった。



上の画像は、マスクのエッジをぼかして滑らかにし、しかも重ね描き部分を一様にアルファ値を80%に
したものである。

GDI+ と違って、従来からの GDI では画像にアルファ値を含めて描画することはできない。
したがって、C# のときと同じ論理では Delphi では同じことはできない。 しかし、ここ
やったように、マスクさえうまく加工することができれば、画像同士の間では自前でアルファブレンドできる。
したがって、すでにライブラリに入っている MaskedOverlay() に与えるマスク画像をどうやってつくるか、
が問題である。

今回作ったのは Crop() と同じ論理でマスクをつくり、それをグレースケール専用の
GaussianBlur でぼかして SmoothEdge と同じ効果を与えるための関数二つと、
できたマスクを一様に薄めることによって SetAlpha32() と同じことをする関数、計3つ
である。

この関数をテストするために簡単なアプリをつくった。



図中の画像は、左からアルファ値が 100%、75%、50% である。また、マスクのエッジをぼかす
割合を可変にすると



左から、SmoothArea が ゼロ、1、3 である。 はめ込み部分のエッジが滑らかになっている。


今回つくった3つの関数部分のソースを記録しておく。

uses
  Clipbrd, VCLImageUtils;

function GaussianBlur8(bmp: TBitmap; zone:integer = 2): Boolean;
var
  tmp: TBItmap;
  src, dst: TBmpData8;
  d: PByte;
  w, h, i, x, y, ix, iy, range: integer;
  count, dd, gauss: single;
  gf: array of single;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;
  if (zone < 1) or (zone > 30) then exit;

  w := bmp.Width;
  h := bmp.Height;

  range := zone*3;
  SetLength(gf,range+1);

  for i := 0 to range do
    gf[i] := exp(-i*i/(2*zone*zone));

  tmp := BmpClone(bmp);

  src := TBmpData8.Create(tmp);
  dst := TBmpData8.Create(bmp);


  // at first, bmp -> tmp (x blur)
  for y := 0 to h-1 do
    for x := 0 to w-1 do
    begin
      count := 0;
      dd := 0;
      for ix := x-range to x+range do
      begin
        if (ix<0) or (ix>w-1) then continue;
        d := dst[ix,y];
        gauss := gf[abs(ix-x)];
        dd := dd+d^*gauss;
        count := count+gauss;
      end;
      src[x,y]^ := AdjustByte(dd/count);
    end;

  // second, tmp -> bmp (y blur)
  for y := 0 to h-1 do
    for x := 0 to w-1 do
    begin
      count := 0;
      dd := 0;
      for iy := y-range to y+range do
      begin
        if (iy<0) or (iy>h-1) then continue;
        d := src[x, iy];
        gauss := gf[abs(iy-y)];
        dd := dd+d^*gauss;
        count := count+gauss;
      end;
      dst[x,y]^ := AdjustByte(dd/count);
    end;

  src.Free;
  dst.Free;
  tmp.Free;

  result := true;
end;

function SetAlphaOnMask8(mask8: TBitmap; Alphapercent: integer): Boolean;
var
  w, h, y, x: integer;
  m: TBmpData8;
begin
  result := false;
  if (AlphaPercent < 0) or (AlphaPercent > 100) then exit;
  if mask8.PixelFormat <> pf8bit then exit;

  w := mask8.Width;
  h := mask8.Height;

  m := TBmpData8.Create(mask8);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
    if m[x, y]^ <> 0 then
      m[x, y]^ := AdjustByte(m[x, y]^ * AlphaPercent / 100.0);

  m.Free;

  result := true;
end;

function MakeMask8(maskBmp: TBitmap; maskColor: TColor; Invert: Boolean;
  AlphaPercent: integer; Tolerance: integer; SmoothArea : integer = 1): TBitmap;
var
  mask8: TBitmap;
  w, h, y, x, rr, gg, bb: integer;
  rgb: LongInt;
  s: TBmpData24;
  m: TBmpData8;
  ps: PRGBTriple;
  sa: double;
begin
  mask8 := TBitmap.Create;
  mask8.PixelFormat := pf8Bit;
  w := maskBmp.Width;
  h := maskBmp.Height;
  mask8.Width := w;
  mask8.Height := h;
  SetGrayPalette(mask8);

  rgb := ColorToRGB(maskColor);
  rr := GetRValue(rgb);
  gg := GetGValue(rgb);
  bb := GetBValue(rgb);

  s := TBmpData24.Create(maskBmp);
  m := TBmpData8.Create(mask8);

  if Invert then
  begin
    for y := 0 to h-1 do
      for x := 0 to w-1 do
      begin
        ps := s[x, y];
        sa := Sqrt((rr - ps^.rgbtRed)*(rr - ps^.rgbtRed) +
                   (gg - ps^.rgbtGreen)*(gg - ps^.rgbtGreen) +
                   (bb - ps^.rgbtBlue)*(bb - ps^.rgbtBlue));
        if sa > Tolerance then
          m[x, y]^ := 0
        else
          m[x, y]^ := 255;
      end;
  end
  else
  begin
    for y := 0 to h-1 do
      for x := 0 to w-1 do
      begin
        ps := s[x, y];
        sa := Sqrt((rr - ps^.rgbtRed)*(rr - ps^.rgbtRed) +
                   (gg - ps^.rgbtGreen)*(gg - ps^.rgbtGreen) +
                   (bb - ps^.rgbtBlue)*(bb - ps^.rgbtBlue));
        if sa > Tolerance then
          m[x, y]^ := 255
        else
          m[x, y]^ := 0;
      end;
  end;

  s.Free;
  m.Free;

  if SmoothArea > 0 then GaussianBlur8(mask8, SmoothArea);

  if AlphaPercent < 100 then SetAlphaOnMask8(mask8, AlphaPercent);

  result := mask8;
end;



MakeMask8 に与える maskBmp は以下のようなもの。





また、base 画像と overlay 画像は既出のものを流用した。

base:




overlay:





[MakeMask8 SetAlphaOnMask8 GaussianBlur8]


Comments (4)

Delphi で Rinkaku Application その10

2007-10-23 00:09:04 | Delphi


前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の10回目。

今回は、前回までに得られた画像のコントラスト調整をする RinkakuContrast() を
作ってテストする。

RinkakuUtils.pas に以下の関数を追加する。

function RinkakuContrast(var bmp: TBitmap; factor: integer): Boolean;
var
  w, h, x, y, i: integer;
  a: double;
  src: TBmpData8;
  d: array[0..255] of byte;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;

  if (factor > 80) or (factor < 0) then exit;

  w := bmp.Width;
  h := bmp.Height;

  a := (127.5 + factor * 1.8) / (127.5 * 127.5) ;

  for i := 0 to 255 do
    if i < 128 then
      d[i] := AdjustByte( -(i-127.5)*(i-127.5)*a + 127.5 - factor)
    else
      d[i] := AdjustByte((i-127.5)*(i-127.5)*a + 127.5 - factor);


  src := TBmpData8.Create(bmp);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
      src[x,y]^ := d[ src[x,y]^];

  src.Free;

  result := true;
end;


テストコードをしめす。

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp, tmp: TBitmap;
begin
  bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
  if not Assigned(bmp) then exit;
  bmp.PixelFormat := pf24bit;

  tmp := BmpClone(bmp);

  if Rinkaku(tmp, 25)
     and Contrast8(tmp, 105, 0.05)
     and AntiBlackOut(bmp, tmp, 55, 30, 0.5)
     and Kuwahara8Ex(tmp, 1, true)
     and Median8(tmp, 1)
     and SetTwoColorGrayScalePalette(tmp, RGB(44, 51, 0), RGB(255, 244, 238))
     //and RinkakuContrast(tmp, 50)
  then
  begin
    Canvas.Draw(5, 35, tmp);
    Clipboard.Assign(tmp);
  end;

  bmp.Free;
  tmp.Free;
end;



RinkakuContrast() なし。


これは、意図的に薄く塗ってある。

RinkakuContrast(tmp, 25)


RinkakuContrast(tmp, 50)


RinkakuContrast(tmp, 75)



今回つくった RinkakuContrast() の合理的な論理はない。
Rinkaku 画像は、エッジ抽出による線画に、元画像の濃淡を薄く重ねたものである。
したがって、輝度のヒストグラムは、線画部分の暗い領域がほんの少し、あとは
うすく塗りつぶした部分の比較的明るい部分が圧倒的に多い。コントラストを強調する
ためには、この比較的明るい部分の分布を拡大し、全体に暗いほうへ分布をシフトさせると
よい。これを簡単な数式と、パラメータを一つだけつかって実現した一例が
RinkakuContrast() フィルタである。

このフィルタの効果を PaintShopPro4 のヒストグラムで見てみよう。

RinkakuContrast() なし。


RinkakuContrast(tmp, 75)


だいたいねらったとおりになっているのが分かるだろう。

今回で Rinkaku Application を作るためのフィルタづくりは終わり。
次回はこのシリーズ最後で、Application を Turbo Delphi でつくる。




Comment

Delphi で Rinkaku Application その9

2007-10-22 00:09:14 | Delphi


前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の9回目。

今回は、Kuwahara8() を拡張した Kuwahara8Ex() とグレースケール専用のメディアン
フィルタ Median8() をつくって、引き続きノイズの低減を目指す。さらに、
グレースケールのパレットの両端を任意の色に設定する SetTwoColorGrayScalePalette()
をつくる。

ここで説明したように、普通の Kuwahara() はカレントピクセルを含む斜め上下の
4区画について、最小の分散区画をもとめ、その区画の色の平均値をカレントの
色とする。この論理を拡張して、斜め上下と、直接の上下区画を4つ加えて、
カレントピクセルを囲む全部で8つの区画について同様にする Kuwahara8Ex() を
試してみよう。

以下の関数を RinkakuUtils.pas に追加する。

function Kuwahara8Ex(var bmp: TBitmap; nBlock: integer;
                                bDetail: Boolean = true): Boolean;
var
  w, h, x, y, i, ix, iy, block, sblock, numBlock: integer;
  indx, min, d: integer;
  t: double;

  tmp: TBitmap;

  src, dst: TBmpData8;

  sig: array[0..7] of integer;
  sum: array[0..7] of integer;

  Xini: array[0..7] of integer;
  Yini: array[0..7] of integer;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;

  if (nBlock > 8) or (nBlock < 1) then exit;

  w := bmp.Width;
  h := bmp.Height;

  block := nBlock * 2 + 1;
  sblock := block - 1;

  numBlock := block * block;

  tmp := TBitmap.Create;
  tmp.PixelFormat := pf24bit;
  tmp.Width := w + sblock * 2;
  tmp.Height := h + sblock * 2;
  tmp.Canvas.Draw(sblock, sblock, bmp);
  GrayScale(tmp);

  src := TBmpData8.Create(tmp);
  dst := TBmpData8.Create(bmp);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
    begin

      Xini[0] := x - sblock; Yini[0] := y - sblock;     // upper-left
      Xini[1] := x; Yini[1] := y - sblock;              // upper-right
      Xini[2] := x; Yini[2] := y;                       // lower-right
      Xini[3] := x - sblock; Yini[3] := y;              // lower-left;
      Xini[4] := x - nBlock; Yini[4] := y - sblock;     // upper
      Xini[5] := x; Yini[5] := y - nBlock;              // right
      Xini[6] := x - nBlock; Yini[6] := y;              // lower
      Xini[7] := x - sblock; Yini[7] := y - nBlock;     // left

      for i := 0 to 7 do
      begin

        sum[i] := 0;
        for ix := Xini[i] to Xini[i] + sblock do
        for iy := Yini[i] to Yini[i] + sblock do
          sum[i] := sum[i] + src[ix+sblock, iy+sblock]^;

        sum[i] := sum[i] div numBlock;

        sig[i] := 0;
        for ix := Xini[i] to Xini[i] + sblock do
          for iy := Yini[i] to Yini[i] + sblock do
          begin
            d := src[ix+sblock, iy+sblock]^;
            sig[i] := sig[i] + (sum[i] - d) * (sum[i] - d);
          end;

        sig[i] := sig[i] div numBlock;
      end;

      min := 90000; indx := 0;

      for i := 0 to 7 do
        if (sig[i] < min) then
        begin
          min := sig[i];
          indx:= i;
        end;

      if (bDetail) then
      begin
        t := Max(0.5, 1.0 - Sqrt(sig[indx]) / 60);
        dst[x, y]^ := AdjustByte(t * sum[indx] + (1 - t) * dst[x, y]^);
      end
      else
        dst[x, y]^ := AdjustByte(sum[indx]);

    end;

  dst.Free;
  src.Free;

  tmp.Free;

  result := true;

end;


テストコードは前回と同じで Kuwahara8() を Kuwahara8Ex() に変えただけである。

uses
  VCLImageUtils, RinkakuUtils, Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp, tmp: TBitmap;
begin
  bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
  if not Assigned(bmp) then exit;
  bmp.PixelFormat := pf24bit;

  tmp := BmpClone(bmp);

  if Rinkaku(tmp, 15) and Contrast8(tmp, 100, 0.04) and
     AntiBlackOut(bmp, tmp, 60, 30, 0.8)
     and Kuwahara8Ex(tmp, 1, true)
  then
  begin
    Canvas.Draw(5, 35, tmp);
    Clipboard.Assign(tmp);
  end;

  bmp.Free;
  tmp.Free;
end;


結果をしめす。



これは、Kuwahara8() よりわずかに良いようだ。


次に、ノイズ除去フィルタの定番である Median8() を試してみる。すでに、Delphi で
pf24bit のカラー画像用には、ここで作った。今回は、Rinkaku 画像用にグレースケール
専用の Median8() をつくる。

RinkakuUtils.pas に以下の関数を追加する。

function ByteSort(Item1, Item2: Pointer): Integer;
begin
  result := byte(Item1)-byte(Item2);
end;

function Median8(var bmp: TBitmap; area: integer = 1):Boolean;
var
  tmp:TBitmap;
  w, h, ix, iy, x, y, xx, yy: integer;
  src, dst: TBmpData8;
  ll: TList;
  md, num, indx: integer;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;

  if (area<1) or (area>4) then exit;

  w := bmp.Width;
  h := bmp.Height;

  num := (2*area+1)*(2*area+1);
  md := Round(num/2);

  ll := TList.Create; ll.Capacity := num; ll.Count := num;

  tmp := BmpClone(bmp);

  src := TBmpData8.Create(tmp);
  dst := TBmpData8.Create(bmp);

  for iy := 0 to h-1 do
    for ix := 0 to w-1 do
    begin
      indx := 0;
      for y := iy-area to iy+area do
        for x := ix-area to ix+area 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;

          ll[indx] := pointer(src[xx, yy]^);
          inc(indx);
        end;

      ll.Sort(ByteSort);

      dst[ix, iy]^ := byte(ll[md]);
    end;

  dst.Free;
  src.Free;

  ll.Free;

  tmp.Free;

  result := true;
end;


前回のテストコードの Kuwahara8Ex() を Median8() に変えた結果を示す。



Median8() 単独でもかなりのノイズ低減効果がある。

Kuwahara8Ex() と Median8() をこの順序で適用した結果を以下にしめす。



もうほとんど完璧かな?

元画像が良質な場合は、Kuwahara8Ex() も Median8() も適用しなくてもよい。
画像の効果として、イラスト風、絵画風を求める場合は、ノイズの有無に関係なく
Kuwahara8Ex() を適用してもよいだろう。


最後に、任意の二色をパレットの両端に設定する関数をつくる。

RinkakuUtils.pas に以下を追加する。

function SetTwoColorGrayScalePalette(var bmp: TBitmap; Dark, Bright: TColor):Boolean;
var
  i: integer;
  ct: array[0..255] of TRGBQuad;
  dr, dg, db, br, bg, bb: Byte;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;

  Dark := ColorToRGB(Dark);
  Bright := ColorToRGB(Bright);
  dr := GetRValue(Dark); dg := GetGValue(Dark); db := GetBValue(Dark);
  br := GetRValue(Bright); bg := GetGValue(Bright); bb := GetBValue(Bright);
  for i := 0 to 255 do
  begin
    ct[i].rgbRed   := Round(dr+(br-dr)*i/255);
    ct[i].rgbGreen := Round(dg+(bg-dg)*i/255);
    ct[i].rgbBlue  := Round(db+(bb-db)*i/255);
    ct[i].rgbReserved := 0;
  end;
  SetDIBColorTable(bmp.Canvas.Handle,0,256,ct);
  DeleteObject(bmp.ReleasePalette);

  result := true;
end;


テストコードを以下にしめす。

uses
  VCLImageUtils, RinkakuUtils, Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp, tmp: TBitmap;
begin
  bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
  if not Assigned(bmp) then exit;
  bmp.PixelFormat := pf24bit;

  tmp := BmpClone(bmp);

  if Rinkaku(tmp, 15) and Contrast8(tmp, 100, 0.04) and
     AntiBlackOut(bmp, tmp, 60, 30, 0.8)
     and Kuwahara8Ex(tmp, 1, true)
     and Median8(tmp, 1)
     and SetTwoColorGrayScalePalette(tmp, RGB(50, 20, 0), RGB(255, 230, 240))
  then
  begin
    Canvas.Draw(5, 35, tmp);
    Clipboard.Assign(tmp);
  end;

  bmp.Free;
  tmp.Free;
end;


この結果は、



となる。

今回はこれまで。

次回は、いよいよフィルタづくりの最後となる Rinkaku 専用のコントラスト調整のための
フィルタをつくる。



Comment

Delphi で Rinkaku Application その8

2007-10-20 00:49:08 | Delphi

前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の8回目。

今回は、前回までで取りきれないかも知れないノイズを、エッジを保つ平均化である
Kuwahara() フィルタでつくって処理することを試す。

Kuwahara() 自体の論理は、C# ですでにここで説明したので繰り返すことはしない。
今回は、これをグレースケールに変換したここと同等なものを Turbo Delphi で
つくる。ただし、C# のときは手抜きしていた統計処理を今回は厳密に標本分散
計算して、それが最小な区画から平均をとることにする。

さっそく実装しよう。RinkakuUtils.pas に以下の関数を追加する。

function Kuwahara8(var bmp: TBitmap; nBlock: integer;
                                bDetail: Boolean = true): Boolean;
var
  w, h, x, y, i, ix, iy, block, sblock, numBlock: integer;
  indx, min, d: integer;
  t: double;

  tmp: TBitmap;

  src, dst: TBmpData8;

  sum: array[0..3] of integer;
  sig: array[0..3] of integer;
  Xini: array[0..3] of integer;
  Yini: array[0..3] of integer;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;

  if (nBlock > 8) or (nBlock < 1) then exit;

  w := bmp.Width;
  h := bmp.Height;

  block := nBlock * 2 + 1;
  sblock := block - 1;

  numBlock := block * block;

  tmp := TBitmap.Create;
  tmp.PixelFormat := pf24bit;
  tmp.Width := w + sblock * 2;
  tmp.Height := h + sblock * 2;
  tmp.Canvas.Draw(sblock, sblock, bmp);
  GrayScale(tmp);

  src := TBmpData8.Create(tmp);
  dst := TBmpData8.Create(bmp);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
    begin

      Xini[0] := x - sblock; Yini[0] := y - sblock;     // upper-left
      Xini[1] := x; Yini[1] := y - sblock;              // upper-right
      Xini[2] := x; Yini[2] := y;                       // lower-right
      Xini[3] := x - sblock; Yini[3] := y;              // lower-left;

      for i := 0 to 3 do
      begin

        sum[i] := 0;
        for ix := Xini[i] to Xini[i] + sblock do
        for iy := Yini[i] to Yini[i] + sblock do
          sum[i] := sum[i] + src[ix+sblock, iy+sblock]^;

        sum[i] := sum[i] div numBlock;

        sig[i] := 0;
        for ix := Xini[i] to Xini[i] + sblock do
          for iy := Yini[i] to Yini[i] + sblock do
          begin
            d := src[ix+sblock, iy+sblock]^;
            sig[i] := sig[i] + (sum[i] - d) * (sum[i] - d);
          end;

        sig[i] := sig[i] div numBlock;
      end;

      min := 90000; indx := 0;

      for i := 0 to 3 do
        if (sig[i] < min) then
        begin
          min := sig[i];
          indx:= i;
        end;

      if (bDetail) then
      begin
        t := Max(0.5, 1.0 - Sqrt(sig[indx]) / 60);
        dst[x, y]^ := AdjustByte(t * sum[indx] + (1 - t) * dst[x, y]^);
      end
      else
        dst[x, y]^ := AdjustByte(sum[indx]);

    end;

  dst.Free;
  src.Free;

  tmp.Free;

  result := true;

end;


この実装の仕方は C# のときとは違う。カレントピクセルを含む小区画の
サイズは nBlock で設定するが、今回は nBlock*2 - 1 であり、nBlock = 1 は
C# のときの2、nBlock = 2 は C# のときの4に相当する。 通常は、nBlock = 1 で
十分である。

このテストコードを以下に示す。

uses
  VCLImageUtils, RinkakuUtils, Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp, tmp: TBitmap;
begin
  bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
  if not Assigned(bmp) then exit;
  bmp.PixelFormat := pf24bit;

  tmp := BmpClone(bmp);

  if Rinkaku(tmp, 15) and Contrast8(tmp, 100, 0.04) and
     AntiBlackOut(bmp, tmp, 60, 30, 0.8)
     and Kuwahara8(tmp, 1, true)
  then
  begin
    Canvas.Draw(5, 35, tmp);
    Clipboard.Assign(tmp);
  end;

  bmp.Free;
  tmp.Free;
end;


結果は



となる。Kuwahara8() を適用しない



と比べると、エッジの周辺、顔のぶつぶつなどが効果的に軽減されていることが分かるだろう。
なお、上の二つは少し同じだけコントラストを強めている。

bDetail = false のときには



となる。最初の画像と比べると、平均化が大きく、ノイズがより低減されているが
歯茎や毛先などのディテールが失われていて、より絵画的になっている。


今回はここまで。
次回は Kuwahara8() を拡張して、より効果的なフィルタを作って試す。

Comment

Delphi で Rinkaku Application その7

2007-10-12 00:06:11 | Delphi

前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の7回目。

今回は、元画像の濃淡を利用して、前回までで得られた線画の上から
塗りつぶす AntiBlackOut() をつくる。

RinkakuUtils.pas に以下の関数を追加する。

function AntiBlackOut(originalBmp: TBitmap; var rinkakuBmp: TBitmap;
            threshold, alphaPercent: integer; decayPercent: double): Boolean;
var
  w, h, sum, count, x, y, ix, iy: integer;
  alpha, decay, a: double;

  tmp: TBitmap;

  src, dst: TBmpData8;
begin

  result := false;
  if originalBmp.PixelFormat <> pf24bit then exit;
  if rinkakuBmp.PixelFormat <> pf8bit then exit;

  if (threshold < 0) or (threshold > 255) then exit;

  if (alphaPercent < 0) or (alphaPercent > 100) then exit;

  w := originalBmp.Width;
  h := originalBmp.Height;

  tmp := BmpClone(originalBmp);
  GrayScale(tmp);

  alpha := alphaPercent / 100.0;
  decay := alpha * decayPercent / 100.0;

  src := TBmpData8.Create(tmp);
  dst := TBmpData8.Create(rinkakuBmp);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
    begin

      sum := 0; count := 0;

      for iy := y-2 to y+2 do
        for ix := x-2 to x+2 do
        begin
          if (ix<0) or (ix>w-1) or (iy<0) or (iy>h-1) then continue;

          sum := sum + src[ix, iy]^;
          Inc(count);
        end;

      sum := sum div count;

      if (sum < threshold) then
        dst[x, y]^ := Min(dst[x, y]^,
                         AdjustByte(dst[x, y]^ * (1.0 - alpha) + src[x, y]^ * alpha))
      else
      begin
        if (decay < 0.00000001) then continue;
        a := alpha - decay * (sum - threshold);
        if (a > 0) then
          dst[x, y]^ := Min(dst[x, y]^,
                            AdjustByte(dst[x, y]^ * (1.0 - a) + src[x, y]^ * a));
      end;

    end;

    dst.Free;
    src.Free;

    tmp.Free;

    result := true;

end;


最初のテストコードをしめす。

uses
  VCLImageUtils, RinkakuUtils, Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp, tmp: TBitmap;
begin
  bmp := LoadPng('C:\Home\ImgWork\RaceQueen.png');
  if not Assigned(bmp) then exit;
  bmp.PixelFormat := pf24bit;

  tmp := BmpClone(bmp);

  //Median(tmp);

  if Rinkaku(tmp, 15) and Contrast8(tmp, 100, 0.04) and
     AntiBlackOut(bmp, tmp, 60, 30, 0.8) then
  begin
    Canvas.Draw(5, 35, tmp);
    Clipboard.Assign(tmp);
  end;

  bmp.Free;
  tmp.Free;
end;


この結果は、



となる。コントラストを調整すると



となる。ノイズがすこし多いことを除けば、かなり完成にちかづいた。

今回つくった AntiBlackOut() の最後の三つのパラメータは重要である。

threshold は、塗りつぶす際に、0-255の輝度のうち、元画像が
この threshold 以下の場合は、線画の濃度と比較して濃いほうを新しい
カレントピクセルの色とする。これを試してみよう。

コントラストを同じだけ調整した結果をしめす。

AntiBlackOut(bmp, tmp, 50, 30, 1.2)


AntiBlackOut(bmp, tmp, 120, 30, 1.2)


このように、髪などの暗い部分の陰影を重視するときには threshold を
小さめに、顔などの明るい部分のグラデーションを重視するときは大きめ
に設定する必要がある。


alphaPercent は、線画の上に重ねる割合を設定する。50 では、半分の濃さ
で塗りつぶす。あまり濃くすると、線画を取得した意味がないので、20から
50の間くらいが適当である。

AntiBlackOut(bmp, tmp, 60, 25, 0.8)


AntiBlackOut(bmp, tmp, 60, 45, 0.8)


このように、線画と塗りつぶしの相対的な濃さを決めるのが alphaPercent である。


decayPercent は、threshold 以上の濃さの減衰の速さを決める。これが大きいと
すぐに塗りつぶしは終わり、相対的に二値化にちかい漫画のような画像になる。
小さいと普通のグレイスケールの画像に近くなり、明るい部分のグラデーションが
相対的に濃く表現される。0.5 から 3.0 くらいの間が適当である。

AntiBlackOut(bmp, tmp, 60, 40, 0.5)


AntiBlackOut(bmp, tmp, 60, 40, 2.5)



このように、AntiBlackOut() のパラメータは、できあがりの画像に大きな影響を
及ぼすので三つのパラメータの設定を慎重に決める。

今回はここまで。
依然として、ノイズが取りきれていない。画像の濃淡を利用したノイズ除去は
S字型とコントラスト調整以上のことはできないので、カレントピクセルの
周囲の色を参照して平均化を行ってノイズを除去してみよう。
次回は、エッジを保存する平均化・ノイズ除去フィルタである Kuwahara8() と
それを拡張した Kuwahara8Ex() フィルタをつくって、今回までに得られた画像に
適用してみる。

Comment

Delphi で Rinkaku Application その6

2007-10-10 00:07:20 | Delphi

前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の6回目。

今回は、Rinkaku() の結果をコントラストを調整して、ノイズを除去する
Contrast8() フィルタをつくる。

すでに Delphi のここでやった Contrast() と同じ論理で、今回のは
グレースケール専用で、中央値を設定できるフィルタをつくる。
論理は同じなので原理は説明しないが、中央値からの輝度の違いに
比例して、白黒の両端に追いやって、二値化にちかい画像にして、
相対的にノイズを低減させる。

それでは、実装してテストしてみよう。

前々回につくった RinkakuUtils.pas に以下の関数を追加する。

function Contrast8(var bmp: TBitmap; midValue, factor: double): Boolean;
var
  w, h, x, y, i: integer;
  value: double;
  src: TBmpData8;
  d: array[0..255] of byte;
begin
  result := false;
  if bmp.PixelFormat <> pf8bit then exit;

  if (factor > 1) or (factor < 0) then exit;
  if (midValue < 50) or (midValue > 200) then exit;

  w := bmp.Width;
  h := bmp.Height;

  value := (1.0 + factor) * (1.0 + factor);

  for i := 0 to 255 do
    d[i] := AdjustByte((i - midValue) * value + midValue);


  src := TBmpData8.Create(bmp);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
      src[x,y]^ := d[ src[x,y]^];

  src.Free;

  result := true;
end;



テスト結果をしめす。

Rinkaku(bmp, 15) and Contrast8(bmp, 100, 0.00)


Rinkaku(bmp, 15) and Contrast8(bmp, 100, 0.02)


Rinkaku(bmp, 15) and Contrast8(bmp, 100, 0.04)


Rinkaku(bmp, 15) and Contrast8(bmp, 100, 0.06)



ご覧のように、コントラスト調整でもかなりノイズを低減できるが
やはり失う情報もある。前回のS字型ノイズ除去とあわせ、適切な
パラメータの選択が必要だ。

テストコードをしめす。

uses
  VCLImageUtils, RinkakuUtils, Clipbrd;

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;

  //Median(bmp);

  if Rinkaku(bmp, 15) and Contrast8(bmp, 100, 0.06) then
  begin
    Canvas.Draw(5, 35, bmp);
    Clipboard.Assign(bmp);
  end;

  bmp.Free;
end;


今回はここまで。

ある程度ノイズ除去に成功したとしても、髪が白髪のままでは
あまり美しくない。次回は、元画像の濃淡を利用して、線画の
上から塗りつぶす AntiBlackOut() フィルタをつくる。


Comment

Delphi で Rinkaku Application その5

2007-10-09 00:06:11 | Delphi

前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の5回目。

今回は、一次微分と二次微分によるエッジ検出フィルタを組み合わせ、
このアプリの中心となる Rinkaku() フィルタをつくる。

Rinkaku() フィルタは、一次微分と二次微分によるエッジ検出結果の
相乗平均によってつくる。これまでに、一次微分として

Contour3()
Contour4()
SobelInvert()

二次微分として

Edge3()
Edge4()

をつくった。したがって、組み合わせの数は6通りある。いろいろ試して、
微妙な違いから、今回は SobelInvert() と Edge4() の組み合わせを採用
することにした。

前回つくった RinkakuUtils.pas に以下の関数を追加する。

function Rinkaku(var bmp: TBitmap; factor: double): Boolean;
var
  tmp:TBitmap;
  w, h, x, y,i: integer;
  src, dst: TBmpData8;
  ct, ed, v: double;
  ff: array[0..255] of double;
begin
  result := false;
  if bmp.PixelFormat <> pf24bit then exit;

  w := bmp.Width;
  h := bmp.Height;

  for i := 0 to 255 do
    ff[i] := factor * Sin(i * PI / 160.0);

  tmp := BmpClone(bmp);

  //Edge3(tmp, true);
  Edge4(tmp, true);

  HistoStretch(tmp);

  //Contour3(bmp, true);
  //Contour4(bmp, true);
  SobelInvert(bmp, true);

  src := TBmpData8.Create(tmp);
  dst := TBmpData8.Create(bmp);

  for y := 0 to h-1 do
    for x := 0 to w-1 do
    begin
      ed := 255 - src[x, y]^;
      ct := 255 - dst[x, y]^;
      v := Sqrt(ed * ct);
      v := v - ff[Trunc(v)];
      dst[x, y]^ := AdjustByte(255 - v);
    end;

  dst.Free;
  src.Free;

  tmp.Free;

  result := true;
end;


ここで、二番目の引数 factor は、Sine 関数をつかった S 字型のノイズ除去
フィルタの強度であり、0から40までの値を設定できる。実際に、この factor を
変えてみた結果を以下にしめす。なお、以下の結果は同じだけコントラストを調整
したものだ。

factor = 0 (S字型ノイズ除去なし)


factor = 10


factor = 20


factor = 30


S字型ノイズ除去は強力である。しかし、髪のディテールなど、失う情報もある。
元画像の質に依存して、factor を試行錯誤で決めなくてはならない。


テストコードを以下にしめす。

uses
  VCLImageUtils, RinkakuUtils, Clipbrd;

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;

  //Median(bmp);

  if Rinkaku(bmp, 30) then
  begin
    Canvas.Draw(5, 35, bmp);
    Clipboard.Assign(bmp);
  end;

  bmp.Free;
end;


かなり、それらしくなってきた。しかし、まだノイズの除去は十分ではない。
これ以降は、ノイズとの戦いである。次回では、まず最初にコントラスト調整
を行うフィルタを作成する。


Comment

Delphi で Rinkaku Application その4

2007-10-08 12:14:17 | Delphi

前回に引き続き、Turbo Delphi で Rinkaku Application をつくる、の4回目。

今回は、いままでつくったフィルタ関数をまとめて RinkakuUtils.pas をつくる。
さらに、これに 前々回の Edge3() を変形した二次微分によるエッジ検出フィルタ
Edge4() を作ってテストする。

まとめた RinkakuUtils.pas のソースを示す。

unit RinkakuUtils;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, StdCtrls, Math;

function Contour3(var bmp: TBitmap; Stretch: Boolean = true): Boolean;
function Contour4(var bmp: TBitmap; Stretch: Boolean = true): Boolean;

function SobelInvert(var bmp: TBitmap; fGray: Boolean = true):Boolean;

function Edge3(var bmp: TBitmap; fGray: Boolean = true):Boolean;


implementation

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;

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;

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;

function Edge3(var bmp: TBitmap; fGray: Boolean = true):Boolean;
const
  mask: array[-2..2] of array[-2..2] of integer =
                          ( (-1, -2, -3, -2, -1),
                            (-2, -3, -4, -3, -2),
                            (-3, -4, 60, -4, -3),
                            (-2, -3, -4, -3, -2),
                            (-1, -2, -3, -2, -1) );
var
  tmp:TBitmap;
  w, h, ix, iy, x, y, xx, yy: integer;
  src, dst: TBmpData24;
  d: PRGBTriple;
  r, g, b: integer;
begin
  result := false;
  if bmp.PixelFormat <> pf24bit then exit;
  w := bmp.Width;
  h := bmp.Height;

  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
      r := 0; g := 0; b := 0;
      for y := iy-2 to iy+2 do
        for x := ix-2 to ix+2 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];

          r := r + mask[x-ix,y-iy]*d^.rgbtRed;
          g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
          b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

        end;
      d := dst[ix,iy];

      d^.rgbtRed := AdjustByte(r+255);
      d^.rgbtGreen := AdjustByte(g+255);
      d^.rgbtBlue := AdjustByte(b+255)
    end;

  dst.Free;
  src.Free;

  tmp.Free;

  if fGray then GrayScale(bmp);

  result := true;
end;

end.


Comment

Delphi で Rinkaku Application その4 (つづき)

2007-10-08 12:13:12 | Delphi
字数制限(10,000)にひっかかったのでつづき。

これに以下のコードを追加する。

宣言部

function Edge4(var bmp: TBitmap; fGray: Boolean = true):Boolean;



実装部
function Edge4(var bmp: TBitmap; fGray: Boolean = true):Boolean;
const
  mask: array[-2..2] of array[-2..2] of integer =
                          ( (-2, -3, -5, -3, -2),
                            (-3, -6, -8, -6, -3),
                            (-5, -8, 108, -8, -5),
                            (-3, -6, -8, -6, -3),
                            (-2, -3, -5, -3, -2) );
var
  tmp:TBitmap;
  w, h, ix, iy, x, y, xx, yy: integer;
  src, dst: TBmpData24;
  d: PRGBTriple;
  r, g, b: integer;
begin
  result := false;
  if bmp.PixelFormat <> pf24bit then exit;
  w := bmp.Width;
  h := bmp.Height;

  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
      r := 0; g := 0; b := 0;
      for y := iy-2 to iy+2 do
        for x := ix-2 to ix+2 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];

          r := r + mask[x-ix,y-iy]*d^.rgbtRed;
          g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
          b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

        end;
      d := dst[ix,iy];

      d^.rgbtRed := AdjustByte(r+255);
      d^.rgbtGreen := AdjustByte(g+255);
      d^.rgbtBlue := AdjustByte(b+255)
    end;

  dst.Free;
  src.Free;

  tmp.Free;

  if fGray then GrayScale(bmp);

  result := true;
end;


Edge3() と Edge4() との違いはマスクの部分だけである。

const
  mask: array[-2..2] of array[-2..2] of integer =
                          ( (-2, -3, -5, -3, -2),
                            (-3, -6, -8, -6, -3),
                            (-5, -8, 108, -8, -5),
                            (-3, -6, -8, -6, -3),
                            (-2, -3, -5, -3, -2) );


これは、Edge3() のときより、カレントピクセルに近い部分の割合を
幾分増やしたものである。

さっそくテストしてみよう。



うーん、すこしだけ Edge3() より好ましいかな。

テストコードをしめす。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  VCLImageUtils, RinkakuUtils;

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;

  //Median(bmp);

  if Edge4(bmp, true) then Canvas.Draw(5, 35, bmp);

  bmp.Free;
end;

end.


今回はここまで。

次回は、いよいよ一次微分と二次微分によるエッジ検出を組み合わせて
このアプリの中心となる Rinkaku() フィルタをつくる。

Comment

Delphi で Rinkaku Application その3

2007-10-05 22:55:52 | Delphi


Delphi で Rinkaku Application をつくる、の3回目。

今回は、カレントピクセルからの差分をとって輪郭抽出を行う
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;


つぎに、カレントを囲む右側四方向ではなく、8方向全部の距離を
計算して、その最大値をとってエッジを検出してみよう。



こんな感じになる。

わずかながら、前回の 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() の変形した二次微分のフィルタをつくって
試してみるのと、フィルタの数が多くなってきたので、新たにユニット
ファイルをつくってライブラリとしてまとめる。


Comment

Delphi で Rinkaku Application その2

2007-10-02 00:21:26 | Delphi

Delphi で Rinkaku Application をつくる、の2回目。

最初は、輪郭抽出の中心となる Edge3() フィルタである。

これは、ここでやった Laplacian() の変形であり、画像データの
変化の二次微分に相当する。マスク部分は

const
  mask: array[-2..2] of array[-2..2] of integer =
                          ( (-1, -2, -3, -2, -1),
                            (-2, -3, -4, -3, -2),
                            (-3, -4, 60, -4, -3),
                            (-2, -3, -4, -3, -2),
                            (-1, -2, -3, -2, -1) );


である。では、さっそく実装してやってみる。



かなりノイズがのっている。方眼紙の升目のようなノイズは jpg の
圧縮ノイズである。それに、デジカメのノイズがのっている。

結局、イラストのような画像を得るためには、このノイズをいかにして
うまく消すか、にかかっている。Laplacian や今回の Edge3() のような
エッジ検出だけでは、このようなノイズが伴ってくるのを防ぎきれない。
だからこそ、Rinkaku Application をつくる意味がある、と思う。

ちなみに、Edge3() の前に、5X5の Median() でノイズを軽減してみると



こうなる。幾分ノイズが減ったが、画像としてのディテールも失っている。

次回は、Contur3() を作って、差分によるエッジ検出フィルタをつくる。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  VCLImageUtils;

function Edge3(var bmp: TBitmap; fGray: Boolean = true):Boolean;
const
  mask: array[-2..2] of array[-2..2] of integer =
                          ( (-1, -2, -3, -2, -1),
                            (-2, -3, -4, -3, -2),
                            (-3, -4, 60, -4, -3),
                            (-2, -3, -4, -3, -2),
                            (-1, -2, -3, -2, -1) );
var
  tmp:TBitmap;
  w, h, ix, iy, x, y, xx, yy: integer;
  src, dst: TBmpData24;
  d: PRGBTriple;
  r, g, b: integer;
begin
  result := false;
  if bmp.PixelFormat <> pf24bit then exit;
  w := bmp.Width;
  h := bmp.Height;

  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
      r := 0; g := 0; b := 0;
      for y := iy-2 to iy+2 do
        for x := ix-2 to ix+2 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];

          r := r + mask[x-ix,y-iy]*d^.rgbtRed;
          g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
          b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

        end;
      d := dst[ix,iy];

      d^.rgbtRed := AdjustByte(r+255);
      d^.rgbtGreen := AdjustByte(g+255);
      d^.rgbtBlue := AdjustByte(b+255)
    end;

  dst.Free;
  src.Free;

  tmp.Free;

  if fGray then GrayScale(bmp);

  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 Edge3(bmp, true) then Canvas.Draw(5, 5, bmp);

  bmp.Free;
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;

  Median(bmp,2);

  if Edge3(bmp, true) then Canvas.Draw(5, 5, bmp);

  bmp.Free;
end;

end.



Comment

Delphi で Rinkaku Application その1

2007-10-01 00:28:30 | Delphi

このブログでマニアックに、そして唐突にはりつけているカテゴリー Rinkaku に
属する画像は、C# で作った Rinkaku Application によって、写真画像を処理
したものである。



下は、この処理結果のコントラストを調整したものである。



この元画像は、



であり、自然写真&写真素材 壁紙 やまさん の(19)の右側の画像を借りたものである。
やまさん、ありがとう。

今回、Turbo Delphi Explorer for Win32 をインストールしたのを機に、これを Delphi に
移植しようと思う。

今回はモチベーションだけ。次回から、フィルタをひとつずつ自作していきながら
最終的に C# で作ったのを上回るようなのを作っていきたい。気がむいたときだけ
ゆっくりと作っていくつもりである。

Comment

Turbo Delphi Explorer のテスト

2007-09-29 19:28:39 | Delphi
早速、動作テストをした。

Turbo Delphi Explorer では、残念ながら新たなコンポーネントをインストール
できないようだ。また、コンパイラが検索するファイルパスも追加することが
できないようだ。そこで、自作の VCLImageUtils.pas やここここでやった
PngImage、GifImage のユニットファイルは、ダウンロードして解凍した
すべてのファイルを、あらかじめパスが通っている $(BDS)lib ディレクトリに
すべてコピーした。これで使えるようになった。

テストとして、上記のすべてを使う LoadCheckedImage() 関数を試してみた。




うまくいっているようだ。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  VCLImageUtils;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TBitmap;
  filename: string;
begin
    filename := 'C:\Home\Img\hana.png';
    bmp := LoadCheckedImage(filename);
    if Assigned(bmp) then
    begin
      Canvas.Draw(5, 5, bmp);
      bmp.Free;
    end;
end;

end.


Comment

Turbo Delphi Explorer for Win32

2007-09-29 00:33:56 | Delphi

Turbo Delphi Explorer for Win32 をインストールした。

PC を新しくして5ヶ月になるけど、やはり Delphi がないのはさびしい。
前の PC には Delphi5pro と Delphi6Personal が入っていたけど、
ちょっと古すぎな感じがする。

Delphi については、すっかり浦島太郎状態だが、お目当ての Delphi6Personal は
いまは使えないらしく、ここを参考にして Turbo Delphi Explorer for Win32 を
インストールした。これは、フリー版では最新のものであるらしい。





なんだか面倒な手続きがあって、BDN の登録からはじめて2時間ちかくかかったが
無事インストールに成功したらしい。いままでつくった画像処理用のライブラリを拡充して
いきたい。しばらく楽しめそうだ。


Comment