📄 main.pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, ComCtrls, ExtDlgs, ImageDef, fft_2d;
type
TFormMain = class(TForm)
MainMenu1: TMainMenu;
ItemFile: TMenuItem;
ItemOpen: TMenuItem;
ItemSave: TMenuItem;
N4: TMenuItem;
ItemExit: TMenuItem;
ItemGeoTrans: TMenuItem;
ItemZoom_in: TMenuItem;
ItemZoom_out: TMenuItem;
ScrollBox1: TScrollBox;
Image1: TImage;
OpenBmpDialog: TOpenPictureDialog;
SaveBmpDialog: TSavePictureDialog;
Zoom_in_2: TMenuItem;
Zoom_in_3: TMenuItem;
Zoom_in_4: TMenuItem;
Zoom_in_5: TMenuItem;
Zoom_out_2: TMenuItem;
Zoom_out_3: TMenuItem;
Zoom_out_4: TMenuItem;
Zoom_out_5: TMenuItem;
ItemPointOperate: TMenuItem;
ItemBinary: TMenuItem;
ItemOrigin: TMenuItem;
ItemFrequency: TMenuItem;
ItemFFT: TMenuItem;
procedure ItemOpenClick(Sender: TObject);
procedure ItemExitClick(Sender: TObject);
procedure ItemSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Zoom_in_2Click(Sender: TObject);
procedure ItemBinaryClick(Sender: TObject);
procedure Zoom_in_3Click(Sender: TObject);
procedure Zoom_in_4Click(Sender: TObject);
procedure Zoom_in_5Click(Sender: TObject);
procedure Zoom_out_2Click(Sender: TObject);
procedure Zoom_out_3Click(Sender: TObject);
procedure Zoom_out_4Click(Sender: TObject);
procedure Zoom_out_5Click(Sender: TObject);
procedure ItemOriginClick(Sender: TObject);
procedure ItemCloseClick(Sender: TObject);
procedure ItemFFTClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Zoom(ZoomScale : Double);
end;
var
FormMain: TFormMain;
SourceMap,TransMap : Tbitmap;
ZoomScale : Double;
Picture : TGrayPicture;
Resultpicture : TGraypicture;
TRANSBEGIN_FFT : Boolean;
implementation
{$R *.DFM}
procedure TFormMain.ItemOpenClick(Sender: TObject);
begin
if OpenBmpDialog.Execute then
begin
SourceMap:=TBitmap.Create ;
TransMap :=TBitmap.Create ;
sourceMap.LoadFromFile(OpenBmpDialog.FileName);
TransMap.LoadFromFile(OpenBmpDialog.FileName);
//TransMap.LoadFromFile(OpenBmpDialog.FileName);
Image1.Picture.LoadFromFile(OpenBmpDialog.FileName);
end;
if Picture=Nil then Picture:=TGrayPicture.Create;
If ResultPicture=Nil Then ResultPicture := TGrayPicture.Create ;
Picture.LoadPictureFromBMPFile ( OpenBmpDialog.Filename );
ResultPicture.Resize (Picture.Width,Picture.Height);
ZoomScale := 1.0 ;
TRANSBEGIN_FFT:=false;
end;
procedure TFormMain.ItemSaveClick(Sender: TObject);
begin
if SaveBmpDialog.Execute then
Image1.Picture.SaveToFile(SaveBmpDialog.FileName);
end;
procedure TFormMain.FormCreate(Sender: TObject);
begin
ZoomScale := 1.0 ;
end;
procedure TFormMain.Zoom(ZoomScale : Double);
Var
SrcHeight , SrcWidth : Integer;
begin
If Picture = Nil Then Exit;
Image1.Stretch := True;
SrcHeight := Picture.Height;
SrcWidth := Picture.Width;
Image1.Height := Round( SrcHeight*ZoomScale);
Image1.Width := Round( SrcWidth*ZoomScale);
//SwImage.Update;
end;
procedure TFormMain.Zoom_in_2Click(Sender: TObject);
begin
ZoomScale:= ZoomScale*2.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_in_3Click(Sender: TObject);
begin
ZoomScale:=ZoomScale*3.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_in_4Click(Sender: TObject);
begin
ZoomScale:=ZoomScale*4.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_in_5Click(Sender: TObject);
begin
ZoomScale:=ZoomScale*5.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_out_2Click(Sender: TObject);
begin
ZoomScale:=ZoomScale/2.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_out_3Click(Sender: TObject);
begin
ZoomScale:=ZoomScale/3.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_out_4Click(Sender: TObject);
begin
ZoomScale:=ZoomScale/4.0;
Zoom(ZoomScale);
end;
procedure TFormMain.Zoom_out_5Click(Sender: TObject);
begin
ZoomScale:=ZoomScale/5.0;
Zoom(ZoomScale);
end;
procedure TFormMain.ItemOriginClick(Sender: TObject);
begin
ZoomScale:= 1.0 ;
Zoom(ZoomScale);
end;
procedure TFormMain.ItemBinaryClick(Sender: TObject);
Var
Threshold : Integer;
x,y : Integer;
k : Tcolor;
Width : Integer;
begin
if Picture=Nil then Exit;
if not Picture.Defined then Exit;
if ResultPicture=Nil then Exit;
if not ResultPicture.Defined then Exit;
Threshold := 100 ;
Screen.Cursor := crHourGlass;
for x:=0 To Picture.Width -1 Do
for y:=0 To Picture.Height -1 Do
Begin
if Picture[x,y]<Threshold then ResultPicture[x,y]:=0
else ResultPicture[x,y]:=255;
End;
ResultPicture.ShowPictureAt(Image1);
Screen.Cursor := crDefault;
end;
procedure TFormMain.ItemExitClick(Sender: TObject);
begin
Close;
end;
procedure TFormMain.ItemCloseClick(Sender: TObject);
begin
Image1.Canvas.Refresh ;
end;
procedure TFormMain.ItemFFTClick(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
fft_2d.fft2d(sourcemap);
//Image1.picture.assign(transmap);
BitMapToGrayPicture( Transmap,ResultPicture ) ;
ResultPicture.ShowPictureAt (image1);
Screen.Cursor := crDefault;
TRANSBEGIN_FFT:=true;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -