CODING EDGE DETECTION
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, Menus, StdCtrls, ExtCtrls, Spin;
type
TRGBTripleArray = array[0..10000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
T3x3FloatArray = array[0..2] of array[0..2] of Extended;
TForm1 = class(TForm)
Image1: TImage;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
GroupBox1: TGroupBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
ComboBox1: TComboBox;
Button1: TButton;
SavePictureDialog1: TSavePictureDialog;
Save1: TMenuItem;
SaveAs1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Edit10: TEdit;
Label1: TLabel;
Edit11: TMenuItem;
Undo1: TMenuItem;
GroupBox2: TGroupBox;
SpinEdit1: TSpinEdit;
Button2: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
Reset1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
procedure Open1Click(Sender: TObject);
procedure EditChange(Sender : TObject);
procedure SetMask(a1, a2, a3, a4, a5, a6, a7, a8, a9 : Extended ; ABias : integer);
procedure FormCreate(Sender: TObject);
procedure ComboBox1Select(Sender: TObject);
procedure Button1Click(Sender: TObject);
function Convolve(ABitmap : TBitmap ; AMask : T3x3FloatArray ; ABias : integer) : TBitmap;
procedure SaveAs1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Undo1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
function Threshold(ABitmap : TBitmap ; AThreshold : byte ;
Intensity,
Saturation,
Red,
Green,
Blue : boolean) : TBitmap;
procedure Reset1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
Mask : T3x3FloatArray;
Bias : integer;
UndoBitmap : TBitmap;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses AboutUnit;
{$R *.dfm}
// initialization
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Tag := 0; Edit2.Tag := 1; Edit3.Tag := 2;
Edit4.Tag := 3; Edit5.Tag := 4; Edit6.Tag := 5;
Edit7.Tag := 6; Edit8.Tag := 7; Edit9.Tag := 8;
Edit10.Tag := 9; // bias
SetMask(1, 1, 1,
1, 1, 1,
1, 1, 1, 0);
UndoBitmap := TBitmap.Create;
UndoBitmap.PixelFormat := pf24bit;
end;
// preset masks
procedure TForm1.ComboBox1Select(Sender: TObject);
begin
if ComboBox1.ItemIndex = 0 then // uniform smoothing
SetMask(1, 1, 1,
1, 1, 1,
1, 1, 1, 0);
if ComboBox1.ItemIndex = 1 then // gaussian smoothing
SetMask(1/36, 1/9, 1/36,
1/9, 4/9, 1/9,
1/36, 1/9, 1/36, 0);
if ComboBox1.ItemIndex = 2 then // edge detection
SetMask(-1, -1, -1,
-1, 8, -1,
-1, -1, -1, 0);
if ComboBox1.ItemIndex = 3 then // vertical edge detection
SetMask( 0, 0, 0,
-1, 2, -1,
0, 0, 0, 0);
if ComboBox1.ItemIndex = 4 then // horizontal edge detection
SetMask( 0, -1, 0,
0, 2, 0,
0, -1, 0, 0);
if ComboBox1.ItemIndex = 5 then // enhanced detail
SetMask( 0, -1, 0,
-1, 9, -1,
0, -1, 0, 0);
if ComboBox1.ItemIndex = 6 then // enhanced focus
SetMask(-1, 0, -1,
0, 7, 0,
-1, 0, -1, 0);
if ComboBox1.ItemIndex = 7 then // emboss filter
SetMask(-1, -1, 0,
-1, 0, 1,
0, 1, 1, 128);
if ComboBox1.ItemIndex = 8 then // lighten
SetMask( 0, 0, 0,
0, 1, 0,
0, 0, 0, 20);
if ComboBox1.ItemIndex = 9 then // darken
SetMask( 0, 0, 0,
0, 1, 0,
0, 0, 0, -20);
end;
procedure TForm1.EditChange(Sender : TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TForm1.SetMask(a1, a2, a3, a4, a5, a6, a7, a8, a9 : Extended ; ABias : integer);
begin
Edit1.Text := FloatToStr(a1);
Edit2.Text := FloatToStr(a2);
Edit3.Text := FloatToStr(a3);
Edit4.Text := FloatToStr(a4);
Edit5.Text := FloatToStr(a5);
Edit6.Text := FloatToStr(a6);
Edit7.Text := FloatToStr(a7);
Edit8.Text := FloatToStr(a8);
Edit9.Text := FloatToStr(a9);
Edit10.Text := IntToStr(ABias);
end;
// open a bitmap into the image
procedure TForm1.Open1Click(Sender: TObject);
begin
if not OpenPictureDialog1.Execute then Exit;
Image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
SaveAs1.Enabled := True;
Save1.Enabled := True;
Reset1.Enabled := True;
end;
// save as new bitmap file
procedure TForm1.SaveAs1Click(Sender: TObject);
begin
if not SavePictureDialog1.Execute then Exit;
Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName);
end;
// overwrite original bitmap file
procedure TForm1.Save1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.SaveToFile(OpenPictureDialog1.FileName);
end;
// convolve
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Save1.Enabled then Exit;
if (Image1.Picture.Bitmap.Width < 3) or (Image1.Picture.Bitmap.Height < 3) then begin
ShowMessage('the image is too small to perform convolution on');
Exit;
end;
UndoBitmap.Width := Image1.Picture.Bitmap.Width;
UndoBitmap.Height := Image1.Picture.Bitmap.Height;
UndoBitmap.Canvas.Draw(0, 0, Image1.Picture.Bitmap);
Undo1.Enabled := True;
Image1.Picture.Bitmap := Convolve(Image1.Picture.Bitmap, Mask, Bias);
end;
function TForm1.Convolve(ABitmap : TBitmap ; AMask : T3x3FloatArray ; ABias : integer) : TBitmap;
Var
LRow1, LRow2, LRow3, LRowOut : PRGBTripleArray;
LRow, LCol : integer;
LNewBlue, LNewGreen, LNewRed : Extended;
LCoef : Extended;
begin
LCoef := 0;
for LRow := 0 to 2 do for LCol := 0 to 2 do LCoef := LCoef + AMask[LCol, LRow];
if LCoef = 0 then LCoef := 1;
Result := TBitmap.Create;
Result.Width := ABitmap.Width - 2;
Result.Height := ABitmap.Height - 2;
Result.PixelFormat := pf24bit;
LRow2 := ABitmap.ScanLine[0];
LRow3 := ABitmap.ScanLine[1];
for LRow := 1 to ABitmap.Height - 2 do begin
LRow1 := LRow2;
LRow2 := LRow3;
LRow3 := ABitmap.ScanLine[LRow + 1];
LRowOut := Result.ScanLine[LRow - 1];
for LCol := 1 to ABitmap.Width - 2 do begin
LNewBlue :=
(LRow1[LCol-1].rgbtBlue*AMask[0,0]) + (LRow1[LCol].rgbtBlue*AMask[1,0]) + (LRow1[LCol+1].rgbtBlue*AMask[2,0]) +
(LRow2[LCol-1].rgbtBlue*AMask[0,1]) + (LRow2[LCol].rgbtBlue*AMask[1,1]) + (LRow2[LCol+1].rgbtBlue*AMask[2,1]) +
(LRow3[LCol-1].rgbtBlue*AMask[0,2]) + (LRow3[LCol].rgbtBlue*AMask[1,2]) + (LRow3[LCol+1].rgbtBlue*AMask[2,2]);
LNewBlue := (LNewBlue / LCoef) + ABias;
if LNewBlue > 255 then LNewBlue := 255;
if LNewBlue < 0 then LNewBlue := 0;
LNewGreen :=
(LRow1[LCol-1].rgbtGreen*AMask[0,0]) + (LRow1[LCol].rgbtGreen*AMask[1,0]) + (LRow1[LCol+1].rgbtGreen*AMask[2,0]) +
(LRow2[LCol-1].rgbtGreen*AMask[0,1]) + (LRow2[LCol].rgbtGreen*AMask[1,1]) + (LRow2[LCol+1].rgbtGreen*AMask[2,1]) +
(LRow3[LCol-1].rgbtGreen*AMask[0,2]) + (LRow3[LCol].rgbtGreen*AMask[1,2]) + (LRow3[LCol+1].rgbtGreen*AMask[2,2]);
LNewGreen := (LNewGreen / LCoef) + ABias;
if LNewGreen > 255 then LNewGreen := 255;
if LNewGreen < 0 then LNewGreen := 0;
LNewRed :=
(LRow1[LCol-1].rgbtRed*AMask[0,0]) + (LRow1[LCol].rgbtRed*AMask[1,0]) + (LRow1[LCol+1].rgbtRed*AMask[2,0]) +
(LRow2[LCol-1].rgbtRed*AMask[0,1]) + (LRow2[LCol].rgbtRed*AMask[1,1]) + (LRow2[LCol+1].rgbtRed*AMask[2,1]) +
(LRow3[LCol-1].rgbtRed*AMask[0,2]) + (LRow3[LCol].rgbtRed*AMask[1,2]) + (LRow3[LCol+1].rgbtRed*AMask[2,2]);
LNewRed := (LNewRed / LCoef) + ABias;
if LNewRed > 255 then LNewRed := 255;
if LNewRed < 0 then LNewRed := 0;
LRowOut[LCol-1].rgbtBlue := trunc(LNewBlue);
LRowOut[LCol-1].rgbtGreen := trunc(LNewGreen);
LRowOut[LCol-1].rgbtRed := trunc(LNewRed);
end;
end;
end;
// threshold
procedure TForm1.Button2Click(Sender: TObject);
Var
LThreshold : integer;
begin
if not Save1.Enabled then Exit;
UndoBitmap.Width := Image1.Picture.Bitmap.Width;
UndoBitmap.Height := Image1.Picture.Bitmap.Height;
UndoBitmap.Canvas.Draw(0, 0, Image1.Picture.Bitmap);
Undo1.Enabled := True;
LThreshold := SpinEdit1.Value;
if RadioButton2.Checked then LThreshold := trunc( LThreshold / 2 );
Image1.Picture.Bitmap := Threshold(Image1.Picture.Bitmap, LThreshold,
RadioButton1.Checked,
RadioButton2.Checked,
RadioButton3.Checked,
RadioButton4.Checked,
RadioButton5.Checked);
end;
function TForm1.Threshold(ABitmap : TBitmap ; AThreshold : byte ;
Intensity,
Saturation,
Red,
Green,
Blue : boolean) : TBitmap;
Var
LRowIn, LRowOut : PRGBTripleArray;
Ly, Lx : integer;
LBlack, LWhite : TRGBTriple;
LR, LG, LB : byte;
LR1, LR2 : integer;
begin
Result := TBitmap.Create;
Result.Width := ABitmap.Width;
Result.Height := ABitmap.Height;
Result.PixelFormat := pf24bit;
LBlack.rgbtBlue := 0; LBlack.rgbtGreen := 0; LBlack.rgbtRed := 0;
LWhite.rgbtBlue := 255; LWhite.rgbtGreen := 255; LWhite.rgbtRed := 255;
for Ly := 0 to ABitmap.Height - 1 do begin
LRowIn := ABitmap.ScanLine[Ly];
LRowOut := Result.ScanLine[Ly];
for Lx := 0 to ABitmap.Width - 1 do begin
LR := LRowIn[Lx].rgbtRed;
LG := LRowIn[Lx].rgbtGreen;
LB := LRowIn[Lx].rgbtBlue;
if Intensity then begin
if (0.3 * LR) + (0.59 * LG) + (0.11 * LB) >= AThreshold
then LRowOut[Lx] := LWhite
else LRowOut[Lx] := LBlack;
end else if Saturation then begin
LR1 := trunc( (-0.105465 * LR) + (-0.207424 * LG) + (0.312889 * LB) );
LR2 := trunc( (0.445942 * LR) + (-0.445942 * LG) );
if Sqrt( Sqr(LR1) + Sqr(LR2) ) >= AThreshold
then LRowOut[Lx] := LWhite
else LRowOut[Lx] := LBlack;
end else if Red then begin
if LR >= AThreshold then LRowOut[Lx] := LWhite
else LRowOut[Lx] := LBlack;
end else if Green then begin
if LG >= AThreshold then LRowOut[Lx] := LWhite
else LRowOut[Lx] := LBlack;
end else begin
if LB >= AThreshold then LRowOut[Lx] := LWhite
else LRowOut[Lx] := LBlack;
end;
end;
end;
end;
// restore previous bitmap
procedure TForm1.Undo1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.Width := UndoBitmap.Width;
Image1.Picture.Bitmap.Height := UndoBitmap.Height;
Image1.Canvas.Draw(0, 0, UndoBitmap);
Undo1.Enabled := False;
end;
// restore original bitmap
procedure TForm1.Reset1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.About1Click(Sender: TObject);
begin
AboutBox.ShowModal;
end;
end.
0 komentar:
Posting Komentar