画像にアンシャープ,ガウシアン,ぼかし,ゴマ塩ノイズ除去(VCL) ~Delphiソースコード集
(参考)バイキュービック法(bicubic)で拡大縮小する(VCL)
(参考)バイキュービック法(bicubic)で拡大縮小する(FMX)
(参考)バイラテラルフィルタ(bilateral filter)で美肌に加工(VCL)
(参考)バイラテラルフィルタ(bilateral filter)で美肌に加工(FMX)
(参考)ソーベルフィルタ(Sobel filter)で境界(エッジ)検出(VCL)
画像フィルターを使用する為のファイルの準備
本ページの下部のソースコードをコピーして「UMamBasicFilter.pas」ファイルを作成し、 プロジェクトフォルダ内に入れる。ソースコードの記述
プロジェクトを新規作成(VCLアプリケーション)し、フォーム(Form1)にTImageを2個、TButtonを5個配置する。Image1のPictureプロパティから、フィルタを適用したい画像をロードしておく。
画像には、スパイクノイズ(ごま塩ノイズ)を意図的に入れたものを使用した

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.ExtCtrls, Vcl.Imaging.jpeg, VCL.Imaging.pngimage; type TForm1 = class(TForm) Image1: TImage; Image2: TImage; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); private { Private 宣言 } public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} uses UMamBasicFilter; procedure TForm1.Button1Click(Sender: TObject); var bmp:TBitmap; begin //Image1をグレースケールにしてImage2に表示 bmp:=TBitmap.Create; try bmp.Assign(Image1.Picture.Graphic); MamGrayScale(bmp,Image2.Picture.Bitmap); finally bmp.Free; end; end; procedure TForm1.Button2Click(Sender: TObject); var bmp:TBitmap; begin //Image1にアンシャープマスク(鮮鋭化)を適用してImage2に表示 bmp:=TBitmap.Create; try bmp.Assign(Image1.Picture.Graphic); MamUnSharp(bmp,Image2.Picture.Bitmap,2); finally bmp.Free; end; end; procedure TForm1.Button3Click(Sender: TObject); var bmp:TBitmap; begin //Image1にガウシアンぼかし(ノイズ除去ぼかし)を適用してImage2に表示 bmp:=TBitmap.Create; try bmp.Assign(Image1.Picture.Graphic); MamGaussian(bmp,Image2.Picture.Bitmap,TMamGaussian.Gaussian5x5); finally bmp.Free; end; end; procedure TForm1.Button4Click(Sender: TObject); var bmp:TBitmap; begin //Image1にぼかし(平滑化、平均化)を適用してImage2に表示 bmp:=TBitmap.Create; try bmp.Assign(Image1.Picture.Graphic); MamBlur(bmp,Image2.Picture.Bitmap,2); finally bmp.Free; end; end; procedure TForm1.Button5Click(Sender: TObject); var bmp:TBitmap; begin //Image1にメディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)を //適用してImage2に表示 bmp:=TBitmap.Create; try bmp.Assign(Image1.Picture.Graphic); MamMedian(bmp,Image2.Picture.Bitmap,1); finally bmp.Free; end; end; end.
実行する
実行ボタンを押して実行します。(デバッグ実行でもOK)Button1をクリックすると、Image1写真画像をグレースケール画像に変換してImage2に表示します。

Button2をクリックすると、Image1写真画像にアンシャープマスク(鮮鋭化)を適用してImage2に表示します。

Button3をクリックすると、Image1写真画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してImage2に表示します。

Button4をクリックすると、Image1写真画像にぼかし(平滑化、平均化)を適用してImage2に表示します。

Button5をクリックすると、Image1写真画像にメディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)を適用してImage2に表示します。

「UMamBasicFilter.pas」ファイルのソースコード
unit UMamBasicFilter; interface uses System.Types,System.UITypes, System.Math, System.Generics.Collections, System.Generics.Defaults, VCL.Graphics; Type TMamBilateral=(Bilateral3x3, Bilateral5x5, Bilateral7x7); TMamGaussian=(Gaussian3x3, Gaussian5x5, Gaussian7x7); TMedian=record v:Byte; x:Integer; y:Integer; end; //src画像のグレースケール画像をdestに作成する procedure MamGrayScale(src,dest:VCL.Graphics.TBitmap); //src画像にアンシャープマスク(鮮鋭化)を適用しdestに作成 //(Strength:0.1~10.0) procedure MamUnSharp(src,dest:VCL.Graphics.TBitmap;Strength:Single=1); //src画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してdestに作成 procedure MamGaussian(src,dest:VCL.Graphics.TBitmap; sm:TMamGaussian=TMamGaussian.Gaussian5x5); //src画像にぼかし(平滑化、平均化)を適用してdestに作成 //(Strength:1~20) procedure MamBlur(src,dest:VCL.Graphics.TBitmap;Strength:Integer=2); //メディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効) //(Strength:1~4) procedure MamMedian(src,dest:VCL.Graphics.TBitmap;Strength:Integer=1); implementation Type TSRGB=record B,G,R:Single; end; TRGB=record B,G,R:Byte; end; TRGBArr=array[0..65535] of TRGB; PRGBArr=^TRGBArr; TRGBArrArr=array[0..65535] of PRGBArr; TMn=array of array of single; TGauss=array of array of single; 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) ); //Delphi標準のTArray.Sort(クイックソート)よりも速い //コムソートを使用する procedure CombSort(a:TArray<TMedian>); //二つの整数の値を入れ替える procedure SwapInt(var v1,v2:TMedian); var sw:TMedian; begin sw:=v1; v1:=v2; v2:=sw; end; var between:Integer;//間隔 i,l,h:integer; begin l:=Low(a); h:=High(a); //初期の比較間隔 between:=System.Math.Floor((h-l+1)/1.3); while between>0 do //比較間隔が0になったら終了 begin i:=l; while h>=(i+between) do begin if a[i].v>a[i+between].v then SwapInt(a[i],a[i+between]); inc(i); end; //比較間隔を小さくする(1.3で割って切り捨て) between:=System.Math.Floor(between/1.3); end; end; //src画像のグレースケール画像をdestに作成する procedure MamGrayScale(src,dest:VCL.Graphics.TBitmap); var v:byte; x,y:integer; SrcBmp,DestBmp:TBitmap;//src,destの一時画像 fRect:TRect; SrcRGB,DestRGB:PRGBArr; begin if not assigned(src) then exit; if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create; fRect.Left:=0; fRect.Top:=0; fRect.Width:=src.Width; fRect.Height:=src.Height; SrcBmp:=VCL.Graphics.TBitmap.Create; DestBmp:=VCL.Graphics.TBitmap.Create; try SrcBmp.PixelFormat:=pf24bit; SrcBmp.Width :=fRect.Width; SrcBmp.Height:=fRect.Height; SrcBmp.Canvas.Draw(0,0,src); DestBmp.PixelFormat:=pf24bit; DestBmp.Width:=fRect.Width; DestBmp.Height:=fRect.Height; dest.Width:=fRect.Width; dest.Height:=fRect.Height; for y := 0 to SrcBmp.Height-1 do begin SrcRGB:=SrcBmp.Scanline[y]; DestRGB:=DestBmp.Scanline[y]; for x := 0 to fRect.Width-1 do begin v:=Round( 0.299*SrcRGB[x].R+ 0.587*SrcRGB[x].G+ 0.114*SrcRGB[x].B ); DestRGB[x].R:=v; DestRGB[x].G:=v; DestRGB[x].B:=v; end; end; dest.Canvas.Draw(0,0,DestBmp); finally SrcBmp.Free; DestBmp.Free; end; end; //src画像にアンシャープマスク(鮮鋭化)を適用しdestに作成 //(Strength:0.1~10.0) procedure MamUnSharp(src,dest:VCL.Graphics.TBitmap;Strength:Single=1); var m:array of array of Single; mn:Integer; num:Integer; x,y,i,j,xx,yy:Integer; fRect:TRect; SrcBmp,DestBmp:VCL.Graphics.TBitmap;//src,destの一時画像 SrcRGB,DestRGB:TRGBArrArr; fSRGB:TSRGB; begin if not assigned(src) then exit; if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create; if Strength<0.1 then Strength:=0.1; if Strength>10 then Strength:=10; //行列の作成 mn:=3; SetLength(m,mn); for i := Low(m) to High(m) do SetLength(m[i],mn); fRect.Left:=0; fRect.Top:=0; fRect.Width:=src.Width; fRect.Height:=src.Height; SrcBmp :=VCL.Graphics.TBitmap.Create; DestBmp:=VCL.Graphics.TBitmap.Create; try SrcBmp.PixelFormat:=pf24bit; SrcBmp.Width :=fRect.Width; SrcBmp.Height:=fRect.Height; SrcBmp.Canvas.Draw(0,0,src); DestBmp.PixelFormat:=pf24bit; DestBmp.Width:=fRect.Width; DestBmp.Height:=fRect.Height; dest.Width:=fRect.Width; dest.Height:=fRect.Height; //スキャンラインの一括取得 for j := 0 to fRect.Height-1 do begin SrcRGB[j]:=SrcBmp.ScanLine[j]; DestRGB[j]:=DestBmp.ScanLine[j]; end; for j := 0 to fRect.Height-1 do begin for i := 0 to fRect.Width-1 do begin fSRGB.R:=0; fSRGB.G:=0; fSRGB.B:=0; //UnSharp行列の作成 num:=0; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin num:=num+1; end; end; end; for y := Low(m) to High(m) do for x := Low(m[y]) to High(m[y]) do m[y][x]:=-Strength/num; m[1][1]:=1+(num-1)*Strength/num; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin fSRGB.R:=fSRGB.R+m[y,x]*SrcRGB[yy][xx].R; fSRGB.G:=fSRGB.G+m[y,x]*SrcRGB[yy][xx].G; fSRGB.B:=fSRGB.B+m[y,x]*SrcRGB[yy][xx].B; end; end; end; if fSRGB.R>255 then fSRGB.R:=255; if fSRGB.G>255 then fSRGB.G:=255; if fSRGB.B>255 then fSRGB.B:=255; if fSRGB.R<0 then fSRGB.R:=0; if fSRGB.G<0 then fSRGB.G:=0; if fSRGB.B<0 then fSRGB.B:=0; DestRGB[j][i].R:=Round(fSRGB.R); DestRGB[j][i].G:=Round(fSRGB.G); DestRGB[j][i].B:=Round(fSRGB.B); end; end; dest.Canvas.Draw(0,0,DestBmp); finally SrcBmp.Free; DestBmp.Free; end; end; //src画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してdestに作成 procedure MamGaussian(src,dest:VCL.Graphics.TBitmap; sm:TMamGaussian=TMamGaussian.Gaussian5x5); var m:array of array of Single; mn:Integer; sum:Single; x,y,i,j,xx,yy:Integer; fRect:TRect; SrcBmp,DestBmp:VCL.Graphics.TBitmap;//src,destの一時画像 SrcRGB,DestRGB:TRGBArrArr; fSRGB:TSRGB; begin if not assigned(src) then exit; if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create; //行列の作成 mn:=3; if sm=TMamGaussian.Gaussian5x5 then mn:=5; if sm=TMamGaussian.Gaussian7x7 then mn:=7; SetLength(m,mn); for i := Low(m) to High(m) do SetLength(m[i],mn); fRect.Left:=0; fRect.Top:=0; fRect.Width:=src.Width; fRect.Height:=src.Height; SrcBmp :=VCL.Graphics.TBitmap.Create; DestBmp:=VCL.Graphics.TBitmap.Create; try SrcBmp.PixelFormat:=pf24bit; SrcBmp.Width :=fRect.Width; SrcBmp.Height:=fRect.Height; SrcBmp.Canvas.Draw(0,0,src); DestBmp.PixelFormat:=pf24bit; DestBmp.Width:=fRect.Width; DestBmp.Height:=fRect.Height; dest.Width:=fRect.Width; dest.Height:=fRect.Height; //スキャンラインの一括取得 for j := 0 to fRect.Height-1 do begin SrcRGB[j]:=SrcBmp.ScanLine[j]; DestRGB[j]:=DestBmp.ScanLine[j]; end; for j := 0 to fRect.Height-1 do begin for i := 0 to fRect.Width-1 do begin fSRGB.R:=0; fSRGB.G:=0; fSRGB.B:=0; //UnSharp行列の作成 sum:=0; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin if mn=3 then sum:=sum+gauss3[y][x] else if mn=5 then sum:=sum+gauss5[y][x] else sum:=sum+gauss7[y][x]; end; end; end; for y := Low(m) to High(m) do begin for x := Low(m[y]) to High(m[y]) do begin if mn=3 then m[y][x]:=gauss3[y][x]/sum else if mn=5 then m[y][x]:=gauss5[y][x]/sum else m[y][x]:=gauss7[y][x]/sum; end; end; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin fSRGB.R:=fSRGB.R+m[y,x]*SrcRGB[yy][xx].R; fSRGB.G:=fSRGB.G+m[y,x]*SrcRGB[yy][xx].G; fSRGB.B:=fSRGB.B+m[y,x]*SrcRGB[yy][xx].B; end; end; end; if fSRGB.R>255 then fSRGB.R:=255; if fSRGB.G>255 then fSRGB.G:=255; if fSRGB.B>255 then fSRGB.B:=255; if fSRGB.R<0 then fSRGB.R:=0; if fSRGB.G<0 then fSRGB.G:=0; if fSRGB.B<0 then fSRGB.B:=0; DestRGB[j][i].R:=Round(fSRGB.R); DestRGB[j][i].G:=Round(fSRGB.G); DestRGB[j][i].B:=Round(fSRGB.B); end; end; dest.Canvas.Draw(0,0,DestBmp); finally SrcBmp.Free; DestBmp.Free; end; end; //src画像にぼかし(平滑化、平均化)を適用してdestに作成 //(Strength:1~20) procedure MamBlur(src,dest:VCL.Graphics.TBitmap;Strength:Integer=2); var mn:Integer; sum:Single; x,y,i,j,xx,yy:Integer; fRect:TRect; SrcBmp,DestBmp:VCL.Graphics.TBitmap;//src,destの一時画像 SrcRGB,DestRGB:TRGBArrArr; fSRGB:TSRGB; begin if not assigned(src) then exit; if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create; if Strength<1 then Strength:=1; if Strength>20 then Strength:=20; mn:=Strength*2+1; fRect.Left:=0; fRect.Top:=0; fRect.Width:=src.Width; fRect.Height:=src.Height; SrcBmp :=VCL.Graphics.TBitmap.Create; DestBmp:=VCL.Graphics.TBitmap.Create; try SrcBmp.PixelFormat:=pf24bit; SrcBmp.Width :=fRect.Width; SrcBmp.Height:=fRect.Height; SrcBmp.Canvas.Draw(0,0,src); DestBmp.PixelFormat:=pf24bit; DestBmp.Width:=fRect.Width; DestBmp.Height:=fRect.Height; dest.Width:=fRect.Width; dest.Height:=fRect.Height; //スキャンラインの一括取得 for j := 0 to fRect.Height-1 do begin SrcRGB[j]:=SrcBmp.ScanLine[j]; DestRGB[j]:=DestBmp.ScanLine[j]; end; for j := 0 to fRect.Height-1 do begin for i := 0 to fRect.Width-1 do begin fSRGB.R:=0; fSRGB.G:=0; fSRGB.B:=0; //UnSharp行列の作成 sum:=0; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin sum:=sum+1; end; end; end; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin fSRGB.R:=fSRGB.R+SrcRGB[yy][xx].R/sum; fSRGB.G:=fSRGB.G+SrcRGB[yy][xx].G/sum; fSRGB.B:=fSRGB.B+SrcRGB[yy][xx].B/sum; end; end; end; if fSRGB.R>255 then fSRGB.R:=255; if fSRGB.G>255 then fSRGB.G:=255; if fSRGB.B>255 then fSRGB.B:=255; if fSRGB.R<0 then fSRGB.R:=0; if fSRGB.G<0 then fSRGB.G:=0; if fSRGB.B<0 then fSRGB.B:=0; DestRGB[j][i].R:=Round(fSRGB.R); DestRGB[j][i].G:=Round(fSRGB.G); DestRGB[j][i].B:=Round(fSRGB.B); end; end; dest.Canvas.Draw(0,0,DestBmp); finally SrcBmp.Free; DestBmp.Free; end; end; //メディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効) //(Strength:1~4) procedure MamMedian(src,dest:VCL.Graphics.TBitmap;Strength:Integer=1); var mn:Integer; Num:Integer; x,y,i,j,xx,yy:Integer; fRect:TRect; SrcBmp,DestBmp,GrayBmp:VCL.Graphics.TBitmap;//src,destの一時画像 SrcRGB,DestRGB,GrayRGB:TRGBArrArr; fSRGB:TSRGB; fMedian:TArray<TMedian>; begin if not assigned(src) then exit; if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create; if Strength<1 then Strength:=1; if Strength>4 then Strength:=4; mn:=Strength*2+1; fRect.Left:=0; fRect.Top:=0; fRect.Width:=src.Width; fRect.Height:=src.Height; //PixelFormatはTPixelFormat.BGRAがデフォルト SrcBmp :=VCL.Graphics.TBitmap.Create; DestBmp:=VCL.Graphics.TBitmap.Create; GrayBmp:=VCL.Graphics.TBitmap.Create; try SrcBmp.PixelFormat:=pf24bit; SrcBmp.Width :=fRect.Width; SrcBmp.Height:=fRect.Height; SrcBmp.Canvas.Draw(0,0,src); DestBmp.PixelFormat:=pf24bit; DestBmp.Width:=fRect.Width; DestBmp.Height:=fRect.Height; GrayBmp.PixelFormat:=pf24bit; GrayBmp.Width:=fRect.Width; GrayBmp.Height:=fRect.Height; MamGrayScale(SrcBmp,GrayBmp); dest.Width:=fRect.Width; dest.Height:=fRect.Height; //スキャンラインの一括取得 for j := 0 to fRect.Height-1 do begin SrcRGB[j]:=SrcBmp.ScanLine[j]; DestRGB[j]:=DestBmp.ScanLine[j]; GrayRGB[j]:=GrayBmp.Scanline[j]; end; for j := 0 to fRect.Height-1 do begin for i := 0 to fRect.Width-1 do begin fSRGB.R:=0; fSRGB.G:=0; fSRGB.B:=0; //UnSharp行列の作成 Num:=0; for y := 0 to mn-1 do begin for x := 0 to mn-1 do begin xx:=i+x-(mn div 2); yy:=j+y-(mn div 2); if not ((xx<0) or (xx>=fRect.Width) or (yy<0) or (yy>=fRect.Height)) then begin Num:=Num+1; SetLength(fMedian,Num); fMedian[Num-1].v:=GrayRGB[yy][xx].R; fMedian[Num-1].x:=xx; fMedian[Num-1].y:=yy; end; end; end; CombSort(fMedian); fSRGB.R:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].R; fSRGB.G:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].G; fSRGB.B:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].B; DestRGB[j][i].R:=Round(fSRGB.R); DestRGB[j][i].G:=Round(fSRGB.G); DestRGB[j][i].B:=Round(fSRGB.B); end; end; dest.Canvas.Draw(0,0,DestBmp); finally SrcBmp.Free; DestBmp.Free; GrayBmp.Free; end; end; end.