バイラテラルフィルタで画像を美肌加工(VCL) ～Delphiソースコード集

バイラテラルフィルタを使用する為のファイルの準備

本ページの下部のソースコードをコピーして「BilateralFilter.pas」ファイルを作成し、プロジェクトフォルダ内に入れる。

プロジェクトの作成とソースコードの記述

プロジェクトを新規作成（VCLアプリケーション）し、フォーム(Form1)にTImageを2個、TButtonを1個配置する。
Image1のPictureプロパティから、バイラテラルフィルタを適用したい画像をロードしておく。
TButton1をダブルクリックして、以下ソースコードを記述する。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils,System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Vcl.StdCtrls, Vcl.Imaging.jpeg, Vcl.ExtCtrls;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses BilateralFilter;

procedure TForm1.Button1Click(Sender: TObject);
var bmp, dest :TBitmap;
    i :integer;
const
    //バイラテラルフィルタの適用回数
    repeat_count:integer=5;
begin
  bmp:=TBitmap.Create;
  bmp.Assign(Image1.Picture.Graphic);
  dest:=TBitmap.Create;

  //バイラテラルフィルタを5回適用する
  for i := 1 to repeat_count do
  begin
    //元Bitmap, 適用後Bitmap, [3x3又は5x5又は7x7フィルタ(デフォルト5x5), [シグマ値(デフォルト20)]]
    MamBilateral(bmp, dest, TMamBilateral.Bilateral5x5, 20);
    bmp.Assign(dest);
  end;

  Image2.Picture.Assign(bmp);
  dest.Free;
  bmp.Free;
end;
end.

実行する

実行ボタンを押して実行します。（デバッグ実行でもOK）

Button1をクリックすると、Image1画像にバイラテラルフィルタ5x5を5回適用した画像をImage2に表示します。

左の梨の写真に、バイラテラルフィルタ（５×５）が5回適用され、皮のブツブツが少し滑らかになって、美肌になっている？
とても処理が重い（3x3フィルタは軽めだが、7x7フィルタは特に重い）ので高解像度画像に適用する場合は要注意。

「BilateralFilter.pas」ファイルのソースコード

unit BilateralFilter;

interface
uses Vcl.Graphics,System.Math;

Type
  TMamBilateral=(Bilateral3x3, Bilateral5x5, Bilateral7x7);

//source画像にバイラテラルフィルタをかけてdestに作成する
procedure MamBilateral(source,dest:TBitmap;
  bai:TMamBilateral=Bilateral3x3;sigma:integer=20);

//source画像のグレースケール画像をdestに作成する
procedure MamGrayScale(source,dest:TBitmap);

const
  //ガウシアンフィルタ係数配列
  gauss3:array[0..2]of array[0..2]of Single=
    (
      (1,2,1),(2,4,2),(1,2,1)
    );
  gauss5:array[0..4]of array[0..4]of Single=
    (
      ( 1, 4, 6, 4, 1), ( 4,16,24,16, 4), ( 6,24,36,24, 6),
      ( 4,16,24,16, 4), ( 1, 4, 6, 4, 1)
    );
  gauss7:array[0..6]of array[0..6] of Single=
    (
      ( 1,  6, 15, 20, 15,  6, 1), ( 6, 36, 90,120, 90, 36, 6),
      (15, 90,225,300,225, 90,15), (20,120,300,400,300,120,20),
      (15, 90,225,300,225, 90,15), ( 6, 36, 90,120, 90, 36, 6),
      ( 1,  6, 15, 20, 15,  6, 1)
    );


implementation
Type
  TMn=array of array of Single;
  TRRGB=record B,G,R:Single; end;
  TRGB =record B,G,R:byte; end;
  TRGBArr=array[0..32767] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..32767] of PRGBArr;
  TGauss=array of array of Single;

//輝度差の正規分布とガウシアンフィルターの係数を掛け合わせる
procedure MamLuminance(i,j,mn:integer;bmp:TBitmap;
  var gaa:TRGBArrArr;var s:TMn;gauss:TGauss;sigma:integer=20);
var x,y,xx,yy,sig:integer;
    sum:Single;
begin
  sig:=sigma*sigma;
  sum:=0;
  for x := 0 to mn*2 do
    for y := 0 to mn*2 do
    begin
      xx:=i+(x-mn);
      if (xx<0) OR (xx>=bmp.Width) then
        xx:=i-(x-mn);
      yy:=j+(y-mn);
      if (yy<0) OR (yy>=bmp.Height) then
        yy:=j-(y-mn);

      s[x][y]:=gaa[j,i].R-gaa[yy][xx].R;
      s[x][y]:=Power(2.71828182845905,
        (-s[x][y]*s[x][y]/sig))*gauss[x,y];
      sum:=sum+s[x,y];
    end;
  for x := 0 to mn*2 do
    for y := 0 to mn*2 do
    begin
      s[x][y]:=s[x][y]/sum;
    end;
end;

procedure MamBilateral(source,dest:TBitmap;
  bai:TMamBilateral=Bilateral3x3;sigma:integer=20);
var i,j,x,y,xx,yy:integer;
    smn:TMn;
    gray:TBitmap;
    gauss:TGauss;
    drgb:TRRGB;
    gaa,saa,daa:TRGBArrArr;
    mn:integer;
begin
  mn:=1;
  if bai=Bilateral5x5 then mn:=2;
  if bai=Bilateral7x7 then mn:=3;

  source.PixelFormat:=pf24bit;
  gray:=TBitmap.Create;
  MamGrayScale(source,gray);
  dest.PixelFormat:=pf24bit;
  dest.SetSize(source.Width,source.Height);

  for j := 0 to gray.Height-1 do
  begin
    gaa[j]:=gray.ScanLine[j];
    saa[j]:=source.ScanLine[j];
    daa[j]:=dest.ScanLine[j];
  end;

  setlength(gauss,mn*2+1);
  setlength(smn,mn*2+1);
  for i := 0 to mn*2 do
  begin
    setlength(gauss[i],mn*2+1);
    setlength(smn[i],mn*2+1);
  end;
  if bai=TMamBilateral.Bilateral3x3 then
    for i := 0 to length(gauss3)-1 do
      for j := 0 to length(gauss3[i])-1 do
        gauss[i][j]:=gauss3[i][j];
  if bai=TMamBilateral.Bilateral5x5 then
    for i := 0 to length(gauss5)-1 do
      for j := 0 to length(gauss5[i])-1 do
        gauss[i][j]:=gauss5[i][j];
  if bai=TMamBilateral.Bilateral7x7 then
    for i := 0 to length(gauss7)-1 do
      for j := 0 to length(gauss7[i])-1 do
        gauss[i][j]:=gauss7[i][j];

  for j := 0 to gray.Height-1 do
  begin
    for i := 0 to gray.Width-1 do
    begin
      MamLuminance(i,j,mn,gray,gaa,smn,gauss,sigma);
      drgb.R:=0;
      drgb.G:=0;
      drgb.B:=0;
      for y := 0 to mn*2 do
        for x := 0 to mn*2 do
        begin
          xx:=i+(x-mn);
          if (xx<0) or (xx>=source.Width) then
            xx:=i-(x-mn);
          yy:=j+(y-mn);
          if (yy<0) or (yy>=source.Height) then
            yy:=j-(y-mn);
          drgb.R:=drgb.R+smn[x][y]*saa[yy][xx].R;
          drgb.G:=drgb.G+smn[x][y]*saa[yy][xx].G;
          drgb.B:=drgb.B+smn[x][y]*saa[yy][xx].B;
        end;
      daa[j,i].R:=Round(drgb.R);
      daa[j,i].G:=Round(drgb.G);
      daa[j,i].B:=Round(drgb.B);
    end;
  end;
  gray.Free;
end;

//グレースケール変換
procedure MamGrayScale(source,dest:TBitmap);
var lines:PRGBArr;//source
    lined:PRGBArr;//dest
    v:byte;
    x,y:integer;
begin
  if not assigned(dest) then dest:=TBitmap.Create;
  source.PixelFormat:=pf24bit;
  dest.PixelFormat:=pf24bit;
  dest.SetSize(source.Width,source.Height);

  for y := 0 to source.Height-1 do
  begin
    lines:=source.ScanLine[y];
    lined:=dest.ScanLine[y];
    for x := 0 to source.Width-1 do
    begin
      v:=round(0.299*lines[x].R+0.587*lines[x].G+0.114*lines[x].B);
      lined[x].R:=v;
      lined[x].G:=v;
      lined[x].B:=v;
    end;
  end;
end;

end.