unit1.pas

这个程序实现了菲涅尔衍射计算

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Image1: TImage;
    TabSheet2: TTabSheet;
    Image2: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    Button4: TButton;
    SavePictureDialog1: TSavePictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
   fff=array[0..1048576] of double;
   const n=8;
   const m=512;
   const wa=0.000632;
   const f=4;
var
  Form1: TForm1;
  imax:double;
  ur,um,umr,umi,per,pei,pee,up:fff;
  
implementation
procedure FFT2(var umr,umi:fff;nx,ny,sg:integer);stdcall;
external'Mydll.dll';

{$R *.dfm}

procedure fenel_transform(var umr,umi:fff;dd,d:double);
var
i,j:integer;
vr,vi,t,x,y:double;
begin
t:=dd/m;
for i:=0 to m-1 do
for j:=0 to m-1 do
begin
x:=-dd/2+dd/m*j;
y:=-dd/2+dd/m*i;
vr:=cos(pi*(x*x+y*y)/(wa*d));
vi:=sin(pi*(x*x+y*y)/(wa*d));
umr[i*m+j]:=(ur[i*m+j]*vr-um[i*m+j]*vi)*t*t;
umi[i*m+j]:=(ur[i*m+j]*vi+um[i*m+j]*vr)*t*t;
end;
end;

procedure  remove(var per,pei:fff);
var
nxy,i,j:integer;
begin
       nxy:=0;
       for i:=0 to m-1 do
       for j:=0 to m-1 do
       begin
       if (i<=m div 2) and (j<=m div 2)
       then Nxy:=(i+m div 2)*m+j+m div 2;
       if (i>=m div 2) and (j<=m div 2)
       then Nxy:=(i-m div 2)*m+j+m div 2;
       if (i<=m div 2) and (j>=m div 2)
       then Nxy:=(i+m div 2)*m+j-m div 2;
       if (i>=m div 2) and (j>=m div 2)
       then Nxy:=(i-m div 2)*m+j-m div 2;
       per[i*m+j]:=umr[Nxy];
       pei[i*m+j]:=umi[Nxy];
       end;
end;

procedure multiply(var ur,um:fff;dd,d:double);
var
    vr,vi,u,v:double;
    vr1,vi1,vr2,vi2:double;
    i,j:Integer;
begin
    imax:=0;
    for i:=0 to m-1 do
    for j:=0 to m-1 do
    begin
    u:=-m*wa*d/(2*dd)+wa*d/dd*j;
    v:=-m*wa*d/(2*dd)+wa*d/dd*i;
    vi:=-cos(pi*(u*u+v*v)/(wa*d));
    vr:=sin(pi*(u*u+v*v)/(wa*d));
    vr1:=cos(2*pi*d/wa)/(wa*d);
    vi1:=sin(2*pi*d/wa)/(wa*d);
    vr2:=vr1*vr-vi1*vi;
    vi2:=vr1*vi+vi1*vr;
    umr[i*m+j]:=per[i*m+j]*vr2-pei[i*m+j]*vi2;
    umi[i*m+j]:=per[i*m+j]*vi2+pei[i*m+j]*vr2;
    ur[i*m+j]:=umr[i*m+j];
    um[i*m+j]:=umi[i*m+j];
     end;
end;

procedure picture;
var
i,j,col:Integer;
ee:double;
begin
    for i := 0 to m - 1 do
    for j:= 0  to m - 1 do
    begin
    ee:=sqrt(ur[i*m+j]*ur[i*m+j]+um[i*m+j]*um[i*m+j]);
    pee[i*m+j]:=ee;
    if imax<ee then
    imax:=ee;
    end;
        for i := 0 to m - 1 do
        for j:= 0  to m - 1 do
         begin
        col:=round(pee[i*m+j]/imax*255);
        if col>255 then
        col:=255;
        form1.Image2.Canvas.Pixels[j,i]:=rgb(col,col,col);
        end;
form1.PageControl1.ActivePageIndex:=1;
end;

procedure picture2;
var
i,j,col:Integer;
ee:double;
begin
    for i := 0 to m - 1 do
    for j:= 0  to m - 1 do
    begin
    ee:=sqrt(per[i*m+j]*per[i*m+j]+pei[i*m+j]*pei[i*m+j]);
    pee[i*m+j]:=ee;
    if imax<ee then
    imax:=ee;
    end;
        for i := 0 to m - 1 do
        for j:= 0  to m - 1 do
         begin
        col:=round(pee[i*m+j]/imax*255);
        if col>255 then
        col:=255;
        form1.Image2.Canvas.Pixels[j,i]:=rgb(col,col,col);
        end;
form1.PageControl1.ActivePageIndex:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    p: pbyteArray;
    ny,nx,x, y: Integer;
    Bmp: TBitmap;
    Gray: integer;
begin
    Self.OpenPictureDialog1.Filter := '*.bmp|*.bmp';
    if self.OpenPictureDialog1.Execute then
    begin
    Image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
    end;
     Bmp := TBitmap.Create;
    Bmp.Assign(Form1.Image1.Picture.Bitmap);
    nx:=bmp.Width;
    ny:=bmp.Height;
    Bmp.PixelFormat := pf24bit;
    for y := 0 to ny - 1 do
    begin
        p := Bmp.scanline[y];
        for x := 0 to nx - 1 do
        begin
            Gray :=(p[3 * x+2]+p[3 * x+1]+ p[3 * x]) div 3;
            ur[y*ny+x]:=Gray;
            um[y*ny+x]:=0;
            end;
    end;
Bmp.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
fenel_transform(umr,umi,8,396);
FFT2(umr,umi,n,n,1);
remove(per,pei);
multiply(ur,um,8,396);
picture;
//...........逆变换............//
fenel_transform(umr,umi,8,-396);
FFT2(umr,umi,n,n,-1);
remove(per,pei);
multiply(ur,um,8,-396);
remove(per,pei);
picture2;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 SavePictureDialog1.Filter := '*.bmp|*.bmp';
  if Self.SavePictureDialog1.Execute then
  begin
    Image2.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName + '.bmp');
  end;
end;

end.