📄 imageprocessmainunit.pas
字号:
//Desiger: Jiang Xiangang 2007.8
unit ImageProcessMainUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, ExtDlgs, JPEG, Buttons, Clipbrd, Menus,math,
ImgList, ToolWin;
type
TImageProcessForm = class(TForm)
ScrollBox1: TScrollBox;
PaintBox1: TPaintBox;
SavePictureDialog1: TSavePictureDialog;
MainMenu1: TMainMenu;
FileItems: TMenuItem;
ImageProcess: TMenuItem;
Gray1: TMenuItem;
ScrollBox2: TScrollBox;
PaintBox2: TPaintBox;
TwoValue: TMenuItem;
OpenImage: TMenuItem;
Exit: TMenuItem;
SaveAs: TMenuItem;
Label1: TLabel;
Label2: TLabel;
LoadPrimitiveImage: TMenuItem;
Filter: TMenuItem;
Erode: TMenuItem;
Help: TMenuItem;
Dilate: TMenuItem;
InvertImage: TMenuItem;
Sobel: TMenuItem;
Prewitt: TMenuItem;
ToolBar2: TToolBar;
OpenFileToolButton: TToolButton;
SaveFileToolButton: TToolButton;
ReLoadToolButton: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ExchangeToolButton: TToolButton;
ImageList1: TImageList;
TwoValueTrackBar: TTrackBar;
ToolButton1: TToolButton;
Label3: TLabel;
TwoValueLabel: TLabel;
Laplace: TMenuItem;
Canny: TMenuItem;
Marr: TMenuItem;
GaussFilter: TMenuItem;
GuassLaplace: TMenuItem;
Robert: TMenuItem;
Kirsh: TMenuItem;
About: TMenuItem;
B1: TMenuItem;
GaborFilter: TMenuItem;
ProgressBar1: TProgressBar;
V1: TMenuItem;
N8Gabor1: TMenuItem;
EightAnisotropic: TMenuItem;
FourAnisotropic: TMenuItem;
ShowAnsiParameter: TMenuItem;
GrayErode: TMenuItem;
GrayDilate: TMenuItem;
Normalize: TMenuItem; procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure BtExitClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure BtsaveClick(Sender: TObject);
procedure InitialImages(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure LaplaceFilter(Sender: TObject);
procedure Gray1Click(Sender: TObject);
procedure TwoValueClick(Sender: TObject);
procedure OpenImageClick(Sender: TObject);
procedure ExitClick(Sender: TObject);
procedure SaveAsClick(Sender: TObject);
procedure PaintBox2Paint(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure TwoValueTrackBarChange(Sender: TObject);
procedure LoadPrimitiveImageClick(Sender: TObject);
procedure FilterClick(Sender: TObject);
procedure SelectionSort(var a: array of integer);
procedure DilateClick(Sender: TObject);
procedure ErodeClick(Sender: TObject);
procedure InvertImageClick(Sender: TObject);
procedure SobelClick(Sender: TObject);
procedure PrewittClick(Sender: TObject);
procedure ExchangeToolButtonClick(Sender: TObject);
procedure MarrClick(Sender: TObject);
procedure CannyClick(Sender: TObject);
procedure GaussFilterClick(Sender: TObject);
procedure GuassLaplaceClick(Sender: TObject);
procedure RobertClick(Sender: TObject);
procedure KirshClick(Sender: TObject);
procedure HelpClick(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure GaborFilterClick(Sender: TObject);
procedure N8Gabor1Click(Sender: TObject);
// procedure A1Click(Sender: TObject);
procedure FourAnisotropicClick(Sender: TObject);
procedure EightAnisotropicClick(Sender: TObject);
procedure GrayErodeClick(Sender: TObject);
procedure GrayDilateClick(Sender: TObject);
procedure NormalizeClick(Sender: TObject);
private
procedure Dimensionpaintbox;
procedure showPrimitiveBmp;
procedure ShowOriginalBmp;
procedure ShowChangedBmp;
end;
var
ImageProcessForm: TImageProcessForm;
WillbeChangedBmp : Tbitmap; // Bitmap read by other unit
CurrentDir : string; //现在的目录
RvalueArray, GvalueArray, BvalueArray: array[0..8] of Integer;
implementation
{$R *.DFM}
uses ImageFileSelect, about, GaborShow, Unit1, ParameterSet;
type
TRGBArray = ARRAY[0..0] OF TRGBTriple; // bitmap element (API windows)
pRGBArray = ^TRGBArray; // type pointer to 3 bytes array
Var
ChangedBmp : Tbitmap; // Bitmap read. Used to restore original image
ProcessedBmp : Tbitmap; // 处理后图像
TestBMP : Tbitmap; // 处理过程中位图
PromitiveBmp : Tbitmap; //
Startdir : string; // 开始目录
curfichier : string; // 现在的文件名
SaveToDir: string; // 保存目录
//---------------------------------------------------------------------------
procedure TImageProcessForm.FormCreate(Sender: TObject);
begin
savetodir := '';
WillbeChangedBmp := tbitmap.create; WillbeChangedBmp.width := 0; WillbeChangedBmp.height := 0;
ChangedBmp := tbitmap.create; ChangedBmp.width := 0; ChangedBmp.height := 0;
ProcessedBmp := Tbitmap.create; ProcessedBmp.width := 0; ProcessedBmp.height := 0;
TestBMP := tbitmap.create; TestBMP.width := 0; TestBMP.height := 0;
PromitiveBmp := tbitmap.create; PromitiveBmp.width := 0; PromitiveBmp.height := 0;
CurrentDir := getcurrentdir;
startdir := getcurrentdir;
end;
procedure TImageProcessForm.FormActivate(Sender: TObject);
begin
// OpenImageClick(sender);
end;
procedure TImageProcessForm.FormDestroy(Sender: TObject);
begin
// WillbeChangedBmp.free;
ChangedBmp.free;
ProcessedBmp.free;
TestBMP.free;
PromitiveBmp.free;
end;
procedure TImageProcessForm.BtExitClick(Sender: TObject);
begin
close;
end;
procedure TImageProcessForm.PaintBox1Paint(Sender: TObject);
begin
ShowOriginalBmp;
end;
procedure TImageProcessForm.FormResize(Sender: TObject);
begin
if ProcessedBmp <> nil then
begin
dimensionpaintbox;
paintbox1.invalidate;
end;
end;
procedure TImageProcessForm.DimensionPaintbox;
begin
Paintbox1.width := WillbeChangedBmp.width;
Paintbox1.height := WillbeChangedBmp.height;
end;
procedure TImageProcessForm.ShowPrimitiveBmp;
begin
with paintbox1.canvas do
begin
copymode := srccopy;
draw(0,0,PromitiveBmp)
end;
end;
procedure TImageProcessForm.ShowOriginalBmp;
begin
with paintbox1.canvas do
begin
copymode := srccopy;
draw(0,0,WillbeChangedBmp)
end;
end;
procedure TImageProcessForm.ShowChangedBmp;
begin
with paintbox2.canvas do
begin
copymode := srccopy;
draw(0,0,ChangedBmp)
end;
end;
procedure TImageProcessForm.InitialImages(Sender: TObject);
begin
ChangedBmp.width := WillbeChangedBmp.width;
ChangedBmp.height := WillbeChangedBmp.height;
ChangedBmp.pixelformat := pf24bit;
ProcessedBmp.width := WillbeChangedBmp.width;
ProcessedBmp.height := WillbeChangedBmp.height;
ProcessedBmp.pixelformat := pf24bit;
TestBMP.width := WillbeChangedBmp.width;
TestBMP.height := WillbeChangedBmp.height;
TestBMP.pixelformat := pf24bit;
PromitiveBmp.width := WillbeChangedBmp.width;
PromitiveBmp.height := WillbeChangedBmp.height;
PromitiveBmp.pixelformat := pf24bit;
Paintbox1.width := WillbeChangedBmp.width;
Paintbox1.height := WillbeChangedBmp.height;
Paintbox2.width := WillbeChangedBmp.width;
Paintbox2.height := WillbeChangedBmp.height;
ChangedBmp.Assign(WillbeChangedBmp);
ProcessedBmp.Assign(WillbeChangedBmp);
TestBMP.Assign(WillbeChangedBmp);
PromitiveBmp.Assign(WillbeChangedBmp);
end;
//--------------------- Gestion des boutons ----------------------
procedure TImageProcessForm.BtsaveClick(Sender: TObject);
var
JP : TJPEGImage;
ctrfich : integer;
i : integer;
ext : string;
begin
{ 文件 ProcessedBmp 的格式 .JPEG 或 .Bmp 或u .GIF}
if savepicturedialog1.execute then
begin
ext :=uppercase(extractfileext(savepictureDialog1.FileName));
if Not ((ext = '.BMP') or (ext = '.JPG')) then
begin
showmessage('错误的文件扩展名 '+curfichier+' (.jpg .bmp)');
// exit;
end;
for i := 1 to 32 do application.processmessages;
if ext = '.BMP' then
begin
ProcessedBmp.savetofile(savepictureDialog1.FileName);
end
else
if ext = '.JPG' then
begin
JP := TJPEGImage.Create; // 创造TJPEGImage 临时文件
try
JP.CompressionQuality := 88; // 压缩比
JP.ProgressiveEncoding := false;
JP.Assign(ProcessedBmp); // 变 JPEG 为bitmap
JP.SaveToFile(savepictureDialog1.FileName); // 保存文件
finally
JP.Free; // 释放 JPEG
end;
end;
sleep(400); //时间等待
curfichier := savepictureDialog1.filename;
ctrfich := ImageSelectForm.filelistbox1.itemindex;
ImageSelectForm.filelistbox1.update;
ImageSelectForm.filelistbox1.itemindex := ctrfich;
end;
end;
procedure TImageProcessForm.Gray1Click(Sender: TObject);
var
p: pbyteArray;
Gray,x, y: Integer;
begin
TestBMP.Assign(WillbeChangedBmp); // WillbeChangedBmp赋予彩色图像
for y := 0 to TestBMP.Height - 1 do
begin
//获取每一行象素信息
p := TestBMP.scanline[y];
for x := 0 to TestBMP.Width - 1 do
begin
//这里采用YUV与RGB颜色空间变换的方法,即 Y＝0.3R+0.59G+0.11B
Gray := Round(p[3 * x + 2] * 0.3 + p[3 * x + 1] * 0.59
+ p[3 * x] * 0.11);
//由于是24位真彩色，故一个像素点为三个字节
p[3 * x + 2] := byte(Gray);
p[3 * x + 1] := byte(Gray);
p[3 * x] := byte(Gray);
//Gray的值必须在0～255之间
end;
end;
ChangedBmp.Assign(TestBMP);
ShowChangedBmp;
end;
procedure TImageProcessForm.TwoValueClick(Sender: TObject);
var
p: PByteArray;
Gray, x, y: Integer;
begin
TestBMP.Assign(WillbeChangedBmp);// WillbeChangedBmp赋予彩色图像
for y := 0 to TestBMP.Height - 1 do
begin
p := TestBMP.scanline[y];
for x := 0 to TestBMP.Width - 1 do
begin //首先将图像灰度化
Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x
* 3] * 0.11);
if Gray >TwoValueTrackBar.position then //按阀值进行二值化
begin
p[x * 3] := 255;
p[x * 3 + 1] := 255;
p[x * 3 + 2] := 255;
end
else
begin
p[x * 3] := 0;
p[x * 3 + 1] := 0;
p[x * 3 + 2] := 0;
end;
end;
end;
ChangedBmp.Assign(TestBMP);
ShowChangedBmp;
end;
procedure TImageProcessForm.OpenImageClick(Sender: TObject);
begin
scrollbox1.horzscrollbar.position := 0;
scrollbox1.vertscrollbar.position := 0;
IF ImageSelectForm.showmodal = mrok then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -