Delphi で Rinkaku Application その２

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

最初は、輪郭抽出の中心となる 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() の前に、５Ｘ５の 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.