unit Canny;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, LCLIntf, Dialogs, Math;
type // type to store a filter
TFilter =
Array of Array of Integer;
// types for fast access to TBitmap image pixels
TRGB =
Array[1..3]
of Byte;
PixArray =
Array[1..MaxInt
div SizeOf(TRGB)-1]
of TRGB;
PPixArray = ^PixArray;
PixArray2D =
Array of PPixArray;
// type to store the pixels of grayscale TBitmaps in an Array
// and to perform filter operations on the array values
TPixelArray =
Array of Array of integer;
// Export
Procedure ConvertToGrayScale(ImgIn : TBitmap;
var ImgOut : TBitmap);
Procedure CalcSobel(ImgIn : TBitmap;
var ImgOut : TBitmap);
implementation
// ############################################################################
// Convert Color Image to Grayscale Image
// ############################################################################
Procedure ConvertToGrayScale(ImgIn : TBitmap;
var ImgOut : TBitmap);
//
var ImgIn2D : PixArray2D;
// Access to ImgIn Pixels
ImgOut2D : PixArray2D;
// Access to ImgOut Pixels
rows,cols : Integer;
// rows and cols of an image
GrayShade : Byte;
// Gray value
//
begin
// Build 2D Arrays via 'scanline' to speed up pixel operations
// access pixels: Img[a]^[b][c] , a=line, b=col, c: 3=R,2=G,or 1=B
// Input Image:
SetLength(ImgIn2D,ImgIn.Height);
For rows := 0
to ImgIn.Height-1
do ImgIn2D[rows] := ImgIn.ScanLine[rows];
// Output Image:
SetLength(ImgOut2D,ImgOut.Height);
For rows := 0
to ImgOut.Height-1
do ImgOut2D[rows] := ImgOut.ScanLine[rows];
// Convert to grayscale:
for rows := 0
to ImgIn.Height-1
do
for cols := 0
to ImgIn.Width-1
do
begin
GrayShade := Round( 0.3 * ImgIn2D[rows]^[cols][3]
+ 0.6 * ImgIn2D[rows]^[cols][2]
+ 0.1 * ImgIn2D[rows]^[cols][1]);
ImgOut2D[rows]^[cols][1] := GrayShade;
// B-value
ImgOut2D[rows]^[cols][2] := GrayShade;
// G-value
ImgOut2D[rows]^[cols][3] := GrayShade;
// R-value
end;
end;
// ############################################################################
// Make Gauss Filter Matrix
// ############################################################################
Procedure MakeGaussFilter(
var Filter : TFilter);
//
var i : Integer;
//
begin
// Set dimensions of filter array
SetLength(Filter,5);
for i := 0
to High(Filter)
do SetLength(Filter[i],5);
// Define Gauss filter matrix
// 2 4 5 4 2
// 4 9 12 9 4
// 5 12 15 12 5
// 4 9 12 9 4
// 2 4 5 4 2
// first Line
Filter[0,0] := 2; Filter[0,1] := 4; Filter[0,2] := 5;
Filter[0,3] := 4; Filter[0,4] := 2;
// second Line
Filter[1,0] := 4; Filter[1,1] := 9; Filter[1,2] := 12;
Filter[1,3] := 9; Filter[1,4] := 4;
// third Line
Filter[2,0] := 5; Filter[2,1] := 12; Filter[2,2] := 15;
Filter[2,3] := 12; Filter[2,4] := 5;
// fourth Line
Filter[3,0] := 4; Filter[3,1] := 9; Filter[3,2] := 12;
Filter[3,3] := 9; Filter[3,4] := 4;
// fifth Line
Filter[4,0] := 2; Filter[4,1] := 4; Filter[4,2] := 5;
Filter[4,3] := 4; Filter[4,4] := 2;
end;
// ############################################################################
// Make Sobel-X Filter Matrix
// ############################################################################
Procedure MakeSobelXFilter(
var Filter : TFilter);
//
var i : integer;
//
begin
// Set dimensions of filter array
SetLength(Filter,3);
for i := 0
to High(Filter)
do SetLength(Filter[i],3);
// Define Sobel-X filter matrix
// -1 0 1
// -2 0 2
// -1 0 1
// first Line
Filter[0,0] := -1; Filter[0,1] := 0; Filter[0,2] := 1;
// second Line
Filter[1,0] := -2; Filter[1,1] := 0; Filter[1,2] := 2;
// third Line
Filter[2,0] := -1; Filter[2,1] := 0; Filter[2,2] := 1;
end;
// ############################################################################
// Make Sobel-Y Filter Matrix
// ############################################################################
Procedure MakeSobelYFilter(
var Filter : TFilter);
//
var i : integer;
//
begin
// Set dimensions of filter array
SetLength(Filter,3);
for i := 0
to High(Filter)
do SetLength(Filter[i],3);
// Define Sobel-Y filter matrix
// 1 2 1
// 0 0 0
// -1 -2 -1
// first Line
Filter[0,0] := 1; Filter[0,1] := 2; Filter[0,2] := 1;
// second Line
Filter[1,0] := 0; Filter[1,1] := 0; Filter[1,2] := 0;
// third Line
Filter[2,0] := -1; Filter[2,1] := -2; Filter[2,2] := -1;
end;
// ############################################################################
// Convert "Image -> Pixel Array" and "Pixel Array -> Image"
// ############################################################################
Procedure ImgToPixArray(ImgIn : TBitmap;
var PixArr : TPixelArray);
//
var H,W : Integer;
ImgIn2D : PixArray2D;
rows, cols : Integer;
//
begin
// Store height and width of input image
H := ImgIn.Height;
W := ImgIn.Width;
// Fast access to input image:
SetLength(ImgIn2D,H);
For rows := 0
to H-1
do ImgIn2D[rows] := ImgIn.ScanLine[rows];
// Set dimensions of pixel array
SetLength(PixArr,H);
For rows := 0
to H-1
do SetLength(PixArr[rows],W);
// Copy pixel values of input image to pixel array
For rows := 0
to H-1
do
For cols := 0
to W-1
do
begin
PixArr[rows,cols] := ImgIn2D[rows]^[cols][1];
end;
end;
Procedure PixArrayToImg(PixArr : TPixelArray;
var ImgOut : TBitmap);
//
var H,W : Integer;
ImgOut2D : PixArray2D;
rows, cols : Integer;
MinVal, MaxVal : integer;
Pixel : Integer;
//
begin
// Store height and width of input image
H := Length(PixArr);
W := Length(PixArr[0]);
// Initialize output image
ImgOut := TBitmap.Create;
ImgOut.Width := W;
ImgOut.Height := H;
// Fast access to output Image:
SetLength(ImgOut2D,H);
For rows := 0
to H-1
do ImgOut2D[rows] := ImgOut.ScanLine[rows];
// Determine minimum and maximum values in pixel array
MinVal := PixArr[0,0];
MaxVal := PixArr[0,0];
For rows := 0
to H-1
do
For cols := 0
to W-1
do
begin
if PixArr[rows,cols] < MinVal
then MinVal := PixArr[rows,cols];
if PixArr[rows,cols] > MaxVal
then MaxVal := PixArr[rows,cols];
end;
// Rescale value range to 0..255 and copy values to output image
For rows := 0
to H-1
do
For cols := 0
to W-1
do
begin
// only scale if necessary
if (MinVal < 0)
or (MaxVal > 255)
then
Pixel := Round(255*((PixArr[rows,cols] - MinVal)/ (MaxVal-MinVal)))
else
Pixel := PixArr[rows,cols];
// Copy values to output image
ImgOut2D[rows]^[cols][1] := Pixel;
ImgOut2D[rows]^[cols][2] := Pixel;
ImgOut2D[rows]^[cols][3] := Pixel;
end;
end;
// ############################################################################
// Apply Filter on Pixel Array
// ############################################################################
Procedure ApplyFilterOnPixArray(PA_In : TPixelArray;
var PA_Out : TPixelArray; Filter : TFilter; DoWeight : Boolean);
//
var H,W : Integer;
// Height and width of ImgIn
rows,cols : Integer;
// rows and cols in the image
weight : Integer;
// Weight for Filter Matrix
FilterBT : Integer;
// Border Thickness of Filter around central element
x, y : Integer;
// Variables for Convolution
PixelSum : Integer;
// Convolution Value
Pixel : Integer;
// Final Pixel Value
//
begin
// Border thickness of filter around central matrix element:
// Examples: 3x3 Matrix -> BT=1 , 5x5 Matrix -> BT=3
FilterBT := Round(0.5 * (Length(Filter)-1));
// Store height and width of input pixel array (PA_In):
H := Length(PA_In);
W := Length(PA_In[0]);
// Set dimensions of output pixel array (PA_Out), "removes Filter Border":
SetLength(PA_Out, H-(2*FilterBT));
For rows := 0
to High(PA_Out)
do SetLength(PA_Out[rows],W-(2*FilterBT));
// Determine filter matrix weight:
weight := 0;
For y := 0
to High(Filter[0])
do
For x := 0
to High(Filter)
do
begin
weight := weight + Abs(Filter[x,y]);
end;
// Calculate filtered Image, i.e. perform convolution of Filter and PA_In -> PA_Out
For rows := FilterBT
to High(PA_In)-FilterBT
do
For cols := FilterBT
to High(PA_In[0])-FilterBT
do
begin
// Perform convolution
PixelSum := 0;
For y := -FilterBT
to FilterBT
do
For x := -FilterBT
to FilterBT
do
begin
PixelSum := PixelSum + Filter[x+FilterBT,y+FilterBT]* PA_In[rows+y,cols+x];
end;
// Apply weight when required
if DoWeight
then Pixel := Round(PixelSum/weight)
else Pixel := PixelSum;
// write output pixel array
PA_Out[rows-FilterBT,cols-FilterBT] := Pixel;
end;
end;
// ############################################################################
// Make final Sobel pixel array based on Sobel-X and Sobel-Y
// ############################################################################
Procedure MakeSobel(PA_Sx, PA_Sy : TPixelArray;
var PA_Out : TPixelArray);
//
var rows, cols : Integer;
Sx, Sy : Integer;
//
begin
// Set dimensions of output pixel array
SetLength(PA_Out,Length(PA_Sx));
For rows := 0
to High(PA_Out)
do SetLength(PA_Out[rows], Length(PA_Sx[0]));
// calculate output pixel array:
For rows := 0
to High(PA_Sx)
do
For cols := 0
to High(PA_Sx[0])
do
begin
Sx := PA_Sx[rows,cols];
Sy := PA_Sy[rows,cols];
// write output pixel array
PA_Out[rows,cols] := Round(sqrt(Sx*Sx + Sy*Sy));
end;
end;
// ############################################################################
// Procedure to perform complete Sobel calculation
// ############################################################################
Procedure CalcSobel(ImgIn : TBitmap;
var ImgOut : TBitmap);
var ImgGray : TBitmap;
PA_Gray, PA_Gauss, PA_SobelX, PA_SobelY, PA_Sobel : TPixelArray;
GaussFilter, SobelX, SobelY : TFilter;
begin
ImgGray := TBitmap.Create;
ImgGray.Width := ImgIn.Width;
ImgGray.Height := ImgIn.Height;
// Convert color input image (ImgIn) to grayscale image (ImgGray)
// and convert ImgGray to pixel array format (PA_Gray)
ConvertToGrayScale(ImgIn,ImgGray);
ImgToPixArray(ImgGray, PA_Gray);
// Apply Gauss smoothening filter to PA_Gray -> PA_Gauss
MakeGaussFilter(GaussFilter);
ApplyFilterOnPixArray(PA_Gray, PA_Gauss, GaussFilter, true);
// Apply SobelX filter to PA_Gauss -> PA_SobelX
MakeSobelXFilter(SobelX);
ApplyFilterOnPixArray(PA_Gauss, PA_SobelX, SobelX, false);
// Apply SobelY filter to PA_Gauss -> PA_SobelY
MakeSobelYFilter(SobelY);
ApplyFilterOnPixArray(PA_Gauss, PA_SobelY, SobelY, false);
// Combine PA_SobelX and PA_SobelY -> PA_Sobel
MakeSobel(PA_SobelX, PA_SobelY, PA_Sobel);
// Convert PA_Sobel to output image (ImgOut)
PixArrayToImg(PA_Sobel, ImgOut);
end;
end.