Image Filters in Delphi (VCL) — Unsharp Mask, Gaussian Blur, Smoothing, and Salt‑and‑Pepper Noise Removal
Preparing the File for Image Filters
Create a new unit file named "UMamBasicFilter.pas" by copying the source code provided at the bottom of this page,
and place the file inside your project folder.
Writing the Source Code
Create a new VCL Application project and place two TImage components and five TButton components on Form1.
Load the image you want to apply filters to into the Picture property of Image1.
For this example, we intentionally use an image that contains salt‑and‑pepper noise (spike noise).
Double‑click Button1, Button2, Button3, Button4, and Button5, and write the following source code.
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 declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses UMamBasicFilter;
procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
begin
// Convert Image1 to grayscale and display it in 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
// Apply Unsharp Mask (sharpening) to Image1 and display it in 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
// Apply Gaussian blur (noise‑reduction blur) to Image1 and display it in 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
// Apply smoothing/average blur to Image1 and display it in 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
// Apply median filter (effective for removing salt‑and‑pepper/spike noise)
// to Image1 and display it in Image2
bmp := TBitmap.Create;
try
bmp.Assign(Image1.Picture.Graphic);
MamMedian(bmp, Image2.Picture.Bitmap, 1);
finally
bmp.Free;
end;
end;
end.
Running the Application
Click the Run button to execute the application (Debug Run is also fine).
When you click Button1, the image in Image1 is converted to a grayscale image and displayed in Image2.
When you click Button2, an Unsharp Mask (sharpening) filter is applied to the image in Image1 and the result is displayed in Image2.
When you click Button3, a Gaussian blur (noise‑reduction blur) is applied to the image in Image1 and displayed in Image2.
When you click Button4, a smoothing/average blur is applied to the image in Image1 and displayed in Image2.
When you click Button5, a median filter (effective for removing salt‑and‑pepper/spike noise) is applied to the image in Image1 and displayed in Image2.
Source Code for the "UMamBasicFilter.pas" File
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;
// Create a grayscale version of the src image and store it in dest
procedure MamGrayScale(src,dest:VCL.Graphics.TBitmap);
// Apply an Unsharp Mask (sharpening) to src and store the result in dest
// (Strength: 0.1–10.0)
procedure MamUnSharp(src,dest:VCL.Graphics.TBitmap;Strength:Single=1);
// Apply a Gaussian blur (noise‑reduction blur) to src and store the result in dest
procedure MamGaussian(src,dest:VCL.Graphics.TBitmap;
sm:TMamGaussian=TMamGaussian.Gaussian5x5);
// Apply a smoothing/average blur to src and store the result in dest
// (Strength: 1–20)
procedure MamBlur(src,dest:VCL.Graphics.TBitmap;Strength:Integer=2);
// Apply a median filter (effective for removing salt‑and‑pepper/spike noise)
// (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
//Gaussian filter coefficient matrices
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)
);
// Comb sort
procedure CombSort(var a:Array of TMedian);
// Swap the values of two TMedian records
procedure SwapInt(var v1,v2:TMedian);
var sw:TMedian;
begin
sw:=v1;
v1:=v2;
v2:=sw;
end;
var between:Integer; // gap between compared elements
i,l,h:integer;
begin
l:=Low(a);
h:=High(a);
// Initial comparison gap
between:=System.Math.Floor((h-l+1)/1.3);
while between>0 do // Stop when the gap becomes 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;
// Reduce the comparison gap (divide by 1.3 and floor)
between:=System.Math.Floor(between/1.3);
end;
end;
//Create a grayscale version of the src image and store it in 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;
dest.SetSize(src.Width,src.Height);
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.SetSize(fRect.Width,fRect.Height);
SrcBmp.Canvas.Draw(0,0,src);
DestBmp.PixelFormat:=pf24bit;
DestBmp.SetSize(fRect.Width,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;
// Apply an Unsharp Mask (sharpening) to src and store the result in dest
// (Strength: 0.1–10.0)
procedure MamUnSharp(src,dest:VCL.Graphics.TBitmap;Strength:Single=1);
var m:array of array of Single;
mn,center:integer;
x,y,i,j,xx,yy:Integer;
fRect:TRect;
SrcBmp,DestBmp:VCL.Graphics.TBitmap; // temporary bitmaps for src and dest
SrcRGB,DestRGB:TRGBArrArr;
fSRGB:TSRGB;
begin
if not assigned(src) then exit;
if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create;
dest.SetSize(src.Width,src.Height);
if Strength<0.1 then Strength:=0.1;
if Strength>10 then Strength:=10;
fRect.Left:=0;
fRect.Top:=0;
fRect.Width:=src.Width;
fRect.Height:=src.Height;
mn:=3;
center:=(mn-1) div 2;
// Create the Unsharp Mask kernel
SetLength(m,mn);
for y := Low(m) to High(m) do
begin
SetLength(m[y],mn);
for x := Low(m[y]) to High(m[y]) do
begin
if (y=center)and(x=center) then
m[y][x]:=1+8*Strength/9
else
m[y][x]:=-Strength/9;
end;
end;
SrcBmp :=VCL.Graphics.TBitmap.Create;
DestBmp:=VCL.Graphics.TBitmap.Create;
try
SrcBmp.PixelFormat:=pf24bit;
SrcBmp.SetSize(fRect.Width,fRect.Height);
SrcBmp.Canvas.Draw(0,0,src);
DestBmp.PixelFormat:=pf24bit;
DestBmp.SetSize(fRect.Width,fRect.Height);
//Retrieve all scanlines at once
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;
for y := 0 to mn-1 do
begin
for x := 0 to mn-1 do
begin
yy:=j+(y-center);
if (yy<0)or(yy>=fRect.Height) then
yy:=j-(y-center);
xx:=i+(x-center);
if (xx<0)or(xx>=fRect.Width) then
xx:=i-(x-center);
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;
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;
// Apply a Gaussian blur (noise‑reduction blur) to src and store the result in dest
procedure MamGaussian(src,dest:VCL.Graphics.TBitmap;
sm:TMamGaussian=TMamGaussian.Gaussian5x5);
var m:array of array of Single;
mn,center:Integer;
msum:Single;
x,y,i,j,xx,yy:Integer;
fRect:TRect;
SrcBmp,DestBmp:VCL.Graphics.TBitmap; // temporary bitmaps for src and dest
SrcRGB,DestRGB:TRGBArrArr;
fSRGB:TSRGB;
begin
if not assigned(src) then exit;
if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create;
dest.SetSize(src.Width,src.Height);
// Create the Gaussian kernel matrix
mn:=3;
msum:=0;
if sm=TMamGaussian.Gaussian5x5 then mn:=5;
if sm=TMamGaussian.Gaussian7x7 then mn:=7;
SetLength(m,mn);
for j := Low(m) to High(m) do
begin
SetLength(m[j],mn);
for i := Low(m[j]) to High(m[j]) do
begin
if mn=3 then
begin
m[j][i]:=gauss3[j][i];
msum:=msum+gauss3[j][i];
end
else if mn=5 then
begin
m[j][i]:=gauss5[j][i];
msum:=msum+gauss5[j][i];
end
else
begin
m[j][i]:=gauss7[j][i];
msum:=msum+gauss7[j][i];
end;
end;
end;
center:=(mn-1) div 2;
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.SetSize(fRect.Width,fRect.Height);
SrcBmp.Canvas.Draw(0,0,src);
DestBmp.PixelFormat:=pf24bit;
DestBmp.SetSize(fRect.Width,fRect.Height);
// Retrieve all scanlines at once
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;
for y := 0 to mn-1 do
begin
for x := 0 to mn-1 do
begin
yy:=j+(y-center);
if (yy<0)or(yy>=fRect.Height) then
yy:=j-(y-center);
xx:=i+(x-center);
if (xx<0)or(xx>=fRect.Width) then
xx:=i-(x-center);
fSRGB.R:=fSRGB.R+m[y,x]*SrcRGB[yy][xx].R/msum;
fSRGB.G:=fSRGB.G+m[y,x]*SrcRGB[yy][xx].G/msum;
fSRGB.B:=fSRGB.B+m[y,x]*SrcRGB[yy][xx].B/msum;
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;
// Apply a blur filter (smoothing / average blur) to src and store the result in dest
// (Strength: 1–20)
procedure MamBlur(src,dest:VCL.Graphics.TBitmap;Strength:Integer=2);
var mn,center:Integer;
x,y,i,j,xx,yy:Integer;
fRect:TRect;
SrcBmp,DestBmp:VCL.Graphics.TBitmap; // temporary bitmaps for src and dest
SrcRGB,DestRGB:TRGBArrArr;
fSRGB:TSRGB;
begin
if not assigned(src) then exit;
if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create;
dest.SetSize(src.Width,src.Height);
if Strength<1 then Strength:=1;
if Strength>10 then Strength:=10;
mn:=Strength*2+1;
center:=(mn-1) div 2;
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.SetSize(fRect.Width,fRect.Height);
SrcBmp.Canvas.Draw(0,0,src);
DestBmp.PixelFormat:=pf24bit;
DestBmp.SetSize(fRect.Width,fRect.Height);
// Retrieve all scanlines at once
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;
for y := 0 to mn-1 do
begin
for x := 0 to mn-1 do
begin
yy:=j+(y-center);
if (yy<0)or(yy>=fRect.Height) then
yy:=j-(y-center);
xx:=i+(x-center);
if (xx<0)or(xx>=fRect.Width) then
xx:=i-(x-center);
fSRGB.R:=fSRGB.R+SrcRGB[yy][xx].R/mn/mn;
fSRGB.G:=fSRGB.G+SrcRGB[yy][xx].G/mn/mn;
fSRGB.B:=fSRGB.B+SrcRGB[yy][xx].B/mn/mn;
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;
// Median filter (effective for removing salt‑and‑pepper / spike noise)
// (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; // temporary bitmaps for src and dest
SrcRGB,DestRGB,GrayRGB:TRGBArrArr;
fMedian:TArray;
begin
if not assigned(src) then exit;
if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create;
dest.SetSize(src.Width,src.Height);
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;
// Default PixelFormat is TPixelFormat.BGRA
SrcBmp :=VCL.Graphics.TBitmap.Create;
DestBmp:=VCL.Graphics.TBitmap.Create;
GrayBmp:=VCL.Graphics.TBitmap.Create;
try
SrcBmp.PixelFormat:=pf24bit;
SrcBmp.SetSize(fRect.Width,fRect.Height);
SrcBmp.Canvas.Draw(0,0,src);
DestBmp.PixelFormat:=pf24bit;
DestBmp.SetSize(fRect.Width,fRect.Height);
GrayBmp.PixelFormat:=pf24bit;
GrayBmp.SetSize(fRect.Width,fRect.Height);
MamGrayScale(SrcBmp,GrayBmp);
// Retrieve all scanlines at once
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
Num:=0;
for y := 0 to mn-1 do
begin
for x := 0 to mn-1 do
begin
yy:=j+y-(mn div 2);
xx:=i+x-(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);
DestRGB[j][i].R:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].R;
DestRGB[j][i].G:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].G;
DestRGB[j][i].B:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].B;
end;
end;
dest.Canvas.Draw(0,0,DestBmp);
finally
SrcBmp.Free;
DestBmp.Free;
GrayBmp.Free;
end;
end;
end.