細線化の方法 (ID：12688)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

> ２値化した画像のエッジを検出し、細線化したいのですが、

ちょうど、フラクタルで同じようなことをしていました。
リージョンをつかって輪郭を描いてみます。

新規で Form1 に Image1 を置いて Width = 400 、Height = 300 に
します。そして Button1 と Button2 を置いて、以下のようにしてみてください。

procedure TForm1.Button1Click(Sender: TObject);
var
  x, y, x1, y1, xx, xmin, xmax, ymin, ymax: Extended;
  n, s, z: integer;
  deltax, deltay: Extended;
  im: TImage;
begin
  im := Image1;
  xmin := -2.0;
  ymin := -1.1;
  xmax := 0.7;
  ymax := 1.2;
  deltax := (xmax - xmin) / im.Width;
  deltay := (ymax - ymin) / im.Height;
  x := xmin;
  for s := 1 to im.Width do
  begin
    y := ymin;
    for z := 1 to im.Height do
    begin
      x1 := 0; y1 := 0;
      n := 0;
      while (n <= 100) and ((x1*x1 + y1*y1) < 4) do
      begin
        n := n + 1;
        xx := x1*x1 - y1*y1 + x;
        y1 := 2 * x1 * y1 + y;
        x1 := xx;
      end;
      if n >= 100 then
      begin
        im.Canvas.Pixels[s,z]:=clBlack;
      end
      else begin
        im.Canvas.Pixels[s, z]:=clWhite;
      end;
    y := y + deltay
    end;
    x := x + deltax
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  x, x1, y:integer;
  RGN: HRGN;
  TrspColor: TColor;
  im: TImage;

procedure AddRgn(x1,x2,y1:integer);
  var
    TmpRectRgn:HRGN;
  begin
    TmpRectRgn := CreateRectRgn(x1,y1,x2,y1+1);
    CombineRgn(RGN,RGN,TmpRectRgn,RGN_OR);
    DeleteObject(TmpRectRgn);
  end;

begin
  im := Image1;
  TrspColor := clWhite;
  Rgn:=CreateRectRgn(0,0,0,0);
  x1 := 1;
  for  y := 1 to im.Height-1 do
  begin
    for x := 1 to im.Width do
      if (((im.Canvas.Pixels[x-1,y]=TrspColor) or (x=1)) and
                             (im.Canvas.Pixels[x,y] <> TrspColor)) then
         x1:=x
      else if ((im.Canvas.Pixels[x-1,y] <> TrspColor) and
               ((im.Canvas.Pixels[x,y] = TrspColor ) or (x=Width)))
                                                        and (x<>1) then
         AddRgn(x1,x,y);
  end;

with im.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(im.ClientRect);
    Brush.Color := clBlack;
    FrameRgn(Handle,RGN,Brush.Handle,1,1);
  end;

DeleteObject(RGN);
end;

Button1 を押すと Image1 にマンデルブロフラクタルが描かれます。
Button2 を押すと不定形リージョンを生成して、その輪郭を描きます。

参考
An Introduction to Fractals
http://astronomy.swin.edu.au/~pbourke/fractals/fracintro/

不定形リージョン（小林 秀和氏による。上記コードはそれを少し改変したもの）
http://www.vector.co.jp/soft/win95/prog/se082336.html

コードは複雑そうに見えますが原理は簡単です。ぜひ試してみてください。

←解決時は質問者本人がここをチェックしてください。

戻る