⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 灰度图象处理的小例子,例子中包括图象的一些处理,很有用的!
💻 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 + -