unit7.pas

本软件是我公司开发的具有实际用途即核磁共振含油率测试分析的源代码。

unit Unit7;

interface
uses
 Windows, Messages,  SysUtils, Variants, Classes,forms;
 
type
//定义新的类型
TP=packed record //处理类型文件的需要
re:single;
im:single;
end;
type xypoint=record
Xpoint:double;
Ypoint:double;
end;

function  EnumChildWndProc(AhWnd:LongInt;AlParam:lParam):boolean;stdcall;
function  OpenExe(ToolButtonIndex:integer):boolean;
procedure FFT(var a:array of real;var b:array of real;m:integer);
////////最小二乘法拟合直线
function CalculateLineKB(const xy: array of xypoint; out k,b: double;n:integer): boolean;



implementation

uses Unt1Main;
//枚举子窗体
function  EnumChildWndProc(AhWnd:LongInt;AlParam:lParam):boolean;stdcall;
var
  WndClassName: array[0..254] of Char;
  WndCaption: array[0..254] of Char;
  s:string;
begin
  GetClassName(AhWnd,wndClassName,254);
  GetWindowText(aHwnd,WndCaption,254);
  s:=wndClassName;
  if s='TToolBar' then
  begin
  //模拟鼠标单击以ahWnd为句柄的组件
      SendMessage(ahWnd,WM_LBUTTONDOWN  ,0,AlParam);
      SendMessage(ahWnd,WM_LBUTTONUP,0,AlParam);
   end;
  result:=true;
end;
//打开另一个应用程序
function  OpenExe(ToolButtonIndex:integer):boolean;
var
enhwnd:HWND;
r:longint;
time1:TDateTime;
begin
  r:=WinExec(pchar(extractfilepath(application.ExeName)+'\oldexe\WinMRIXP.exe'),SW_SHOWNORMAL);
  if r>31 then
        time1:=now
  else
    begin
       application.MessageBox (PCHAR('文件没有找到！'),'提示', MB_ICONQUESTION+MB_OK);
       exit;
    end;
  repeat
  until time1+StrtoTime('00:00:2')<=now;   //延时5秒
  enhwnd:=FindWindow(nil,'WinMRIXP');
  if enhwnd<>0 then
  begin
    sendmessage(enhwnd,SW_SHOWMINIMIZED,0,0);
    EnumChildWindows(enhwnd,@EnumChildWndProc,ToolButtonIndex);
  end;
  result:=true;
end;
//快速FFT
procedure FFT(var a:array of real;var b:array of real;m:integer);
var
i,n,k,l,j,j1,j2,jj1,jj2,lc,nc1,nc2,n1,n2:integer;
a1,b1,c,s,cb,sb,cc,sc,r1,r2,th:real;
begin
        n:=1 shl m; //1024
        for l:=1 to m do
          begin
                lc:=(1 shl l) div 2;
                nc2:=n div lc;
                nc1:=nc2 div 2;
                th:=lc*2*PI/n;
                sc:=sin(th);
                cc:=-2*sqr(sin(th/2));//*(sin(th/2));
                for k:=1 to lc do
                  begin
                        j1:=(k-1)*nc2;
                        j2:=j1+nc1;
                        s:=0;
                        c:=1;
                        for j:=0 to nc1-1 do
                          begin
                                jj1:=j1+j;
                                jj2:=j2+j;
                                r1:=a[jj1];
                                r2:=b[jj1];
                                a[jj1]:=r1+a[jj2];
                                b[jj1]:=r2+b[jj2];
                                a1:=r1-a[jj2];
                                b1:=r2-b[jj2];
                                a[jj2]:=a1*c+b1*s;
                                b[jj2]:=b1*c-a1*s;
                                sb:=cc*s+sc*c+s;
                                cb:=cc*c-sc*s+c;
                                s:=sb;
                                c:=cb;
                          end;
                  end;
          end;
        j:=0;
        n2:=n div 2;
        n1:=n-1;
        for i:=0 to n1-1 do
          begin
                if j>i then
                  begin
                        r1:=a[j];
                        r2:=b[j];
                        a[j]:=a[i];
                        b[j]:=b[i];
                        a[i]:=r1;
                        b[i]:=r2;
                  end;
                k:=n2;
                while(j>=k) do
                  begin
                        j:=j-k;
                        k:=k div 2;
                  end;
                j:=j+k;

          end;
end;
////////最小二乘法拟合直线
function CalculateLineKB(const xy: array of xypoint; out k,b: double;n:integer): boolean;
var
i:integer;
mX,mY,mXX,mXY:double;
begin
if n=0 then
    result:= FALSE;
mX:=0.0;
mY:=0.0;
mXX:=0.0;
mXY:=0.0;
for i:=0 to n-1 do
 begin
        mX:=mX+xy[i].Xpoint ;
        mY:=mY+xy[i].Ypoint ;
        mXX:=mXX+xy[i].Xpoint*xy[i].Xpoint ;
        mXY:=mXY+xy[i].Xpoint *xy[i].Ypoint ;
end;
        if(mX*mX-mXX*n)=0 then
             result:= FALSE;
        k:=(mY*mX-mXY*n)/(mX*mX-mXX*n);
        b:=(mY-mX*k)/n;
        result:= TRUE;
end;
end.