untbd2.pas

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

                s3:=RightStr(edit2.Text,4);   //.txt
                i4:=length(edit2.Text)-i3;
                s4:=RightStr(edit2.Text,i4);
                i5:=LastDelimiter('.', s4);
                s5:=LeftStr(s4,i5-1); ///////////// strtoint
                s6:=s2+ inttostr(strtoint(s5)+1)+s3;
                edit2.Text:=s6;


          if i1-i2-1=0 then
             begin
             showmessage('已经添加好标样！');
             edit5.Text:='';
             edit2.Text:='';
             edit6.Text:='';
             edit7.Text:='';
             end
            else
             begin
               showmessage('已经成功添加了一条标样记录!'+#13+'还有'+inttostr(i1-i2-1)+'个标样要添加！');
             //  BitBtn3.Enabled:=false;
                Edit5.Text:=inttostr(i2+2);
             //   edit5.Enabled:=false;
                edit6.SetFocus;
             end;
//         edit5.Text:='';
         //edit6.Text:='';
         edit7.Text:='';

        end;
          ADOQuery1jb.Close;
          ADOQuery1jb.SQL.Clear;
          ADOQuery1jb.SQL.Add('select * from BYANG order by testno  desc, bybh asc');
          ADOQuery1jb.Open;

end;


function  TFrmbd2.Shiyutu(ssa1:string):string;
var
  hWndClose: HWnd;
  mypath:string;
  i,j,i1:integer;
  Tmp,ddd:real;
a:array[0..2048] of real;
b:array[0..2048] of real;
c:array[0..2048] of real;
d:array[0..2048] of real;
e:array[0..2048] of real; //实部和虚部的模
TPFile:file of TP;
x:TP;
begin

    PageControl1.TabIndex :=0;
     PageControl1.ActivePage:=TabSheet1;  //
        assignfile(TPFile,ssa1);    //ssa1--FID文件
        reset(TPFile);
        sampling.Series[0].Clear;
        i:=0;
        try

           while (not eof(TPFile))  do
            begin
              if i>2047 then
                begin
                  showmessage('TD参数设置不对，应该为1024或2048。'+#13+'请重新设置测量！');
                  break;
                end;
                  read(TPFile,x);
                  a[i] :=x.re;      //实部
                  b[i]:=x.im ;      //虚部
                  e[i]:=sqrt(a[i]*a[i]+b[i]*b[i]); //实部和虚部的模
       memo1.Lines.Add(inttostr(i)+'   '+floattostr(a[i])+',    '+floattostr(b[i])+'  ');   //测试胡数据
                  sampling.Series[0].Add((e[i]));   //划线
                  Chart1.Series[0].Add((a[i]));
                  inc(i);
           end;
         finally
                closefile(TPFile);
         end;
     ///////////////////////////////////////
          j:=Series1.YValues.Locate(Series1.MaxYValue);   //最大值位置
          //求最大值附近40个值的平均值
          ddd:=0.0;
          for i1:=j-10 to j+10 do
            begin
             d[i1]:=sqrt(a[i1]*a[i1]+b[i1]*b[i1])+ddd; //实部和虚部的模
             ddd:=d[i1];
            end;

           tmp:=ddd/21;   // 最大值附近40个值的平均值
//           Tmp:= Series1.MaxYValue; //最大值的模
//          label4.Caption :='时域图的最大值在'+FloatTostr(j)+'处' ;
          showmessage('最大值位置在'+inttostr(j)+#13+'最大值='+floattostr(tmp));
            result:=FormatFloat('0.000',Tmp);   //最大值
end;


procedure TFrmbd2.BitBtn3Click(Sender: TObject);      //标定
   var
    i1,i2:integer;
    s1,sk1,sk2,sb1,sb2:string;
    aa:array of xypoint;
    i:integer;
    k,b:double;
begin


  if   edit1.Text='' then
      begin
        showmessage('请输入标定编号！');
        exit;
      end;
 { if   edit3.Text='' then
      begin
        showmessage('请输入标定人姓名！');
        exit;
      end; }
            Chart2.Series[0].Clear; 
   s1:='select count(*) as find from BYANG where testno='+QuotedStr(edit1.Text);
        try
          ADOQuery4.Close;
          ADOQuery4.SQL.Clear;
          ADOQuery4.SQL.Add(s1);
          ADOQuery4.Open;
          i1:=ADOQuery4.FieldByName('find').AsInteger;
         finally
          end;
           if  i1=0 then
             begin
               showmessage('您输入的标定编号不存在'+#13+'请重新输入！');
               exit;
             end;
         s1:='select *  from BYANG where testno='+QuotedStr(edit1.Text);
          ADOQuery3.Close;
          ADOQuery3.SQL.Clear;
          ADOQuery3.SQL.Add(s1);
          ADOQuery3.Open;
          PageControl1.ActivePage :=TAbSheet2;
         setlength(aa,i1);
         ADOQuery3.First;
         i2:=0;
         Series2.Clear ;
           while not ADOQuery3.Eof do
           begin
             aa[i2].Ypoint :=strtofloat(ADOQuery3.FieldByName('maxweizhi').AsString);  //核磁共振信号与质量之比
             aa[i2].Xpoint :=strtofloat(ADOQuery3.FieldByName('bzhhl').AsString);  //标准含量
             i2:=i2+1;
            ADOQuery3.Next;
           end;

   {       PageControl1.ActivePage :=TAbSheet2;

      setlength(aa,3);

           aa[0].xpoint:=200.0;    aa[0].ypoint:=120.0;
           aa[1].xpoint:=300.0;     aa[1].ypoint:=250.0;
           aa[2].xpoint:=420.0;   aa[2].ypoint:=500.0;
            i1:=3;  }
      if CalculateLineKB(aa,k,b,i1)   then         //i1：点的数量

         begin
            for i:=low(aa) to high(aa) do
               LineSeries1.AddXY(aa[i].Xpoint ,aa[i].Ypoint );
           x0:=0;
           y0:=k*x0+b;
    //       x1:=LineSeries1.MaxXValue;
           x1:=LineSeries1.MaxXValue;
           y1:=k*x1+b;
          end;
           sk1:='斜率：';
           sb1:='截距：';
           sk2:= FormatFloat('0.000',k);   //斜率
           sb2:= FormatFloat('0.000',b);   //截距
           Label10.Caption:=sk1+sk2;
           Label11.Caption:=sb1+sb2;

       s1:='select count(*) as find from bd1 where testno='+QuotedStr(trim(edit1.Text));
               ADOQuery1.Close;
               ADOQuery1.SQL.Clear;
               ADOQuery1.SQL.Add(s1);
               ADOQuery1.open;
               i2:=ADOQuery1.FieldByName('find').AsInteger;     //查标定编号
        if (i2>0) then                //新记录
          begin
            s1:='UPDATE   BD1 SET testno='+QuotedStr(edit1.Text)
                +',testname='+QuotedStr(edit3.Text)
                +',xielv='+QuotedStr(sk2)
                +',jieju='+QuotedStr(sb2)
                +',dbx0=' +QuotedStr(floattostr(x0))
                +',dby0=' +QuotedStr(floattostr(y0))
                +',dbx1=' +QuotedStr(floattostr(x1))
                +',dby1=' +QuotedStr(floattostr(y1));

          end
         else
          begin
            s1:='INSERT INTO BD1(testno,testname,xielv,jieju,dbx0,dby0,dbx1,dby1) VALUES('
              +QuotedStr(edit1.Text)
              +','+QuotedStr(edit3.Text)
              +','+QuotedStr(sk2)
              +','+QuotedStr(sb2)
              +','+QuotedStr(floattostr(x0))
              +','+QuotedStr(floattostr(y0))
              +','+QuotedStr(floattostr(x1))
              +','+QuotedStr(floattostr(y1))
              +')';
          end;

          ADOQuery1.Close;
          ADOQuery1.SQL.Clear;
          ADOQuery1.SQL.Add(s1);
          ADOQuery1.ExecSQL;

end;


////////////////////最小二乘法拟合直线
function TFrmbd2.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
          begin
             k:=0;
             b:=mY/n;
             result:= FALSE;
           end
         else
           begin
             k:=(mY*mX-mXY*n)/(mX*mX-mXX*n);
             b:=(mY-mX*k)/n;
             result:= TRUE;
           end;
end;



      {
procedure TFrmbd2.Series5AfterDrawValues(Sender: TObject);
begin
        With chart2.Canvas do
        Begin
         Pen.Width:=2;
         Pen.Style:=psSolid;
         Pen.Color:=clRed;
         MoveTo(Series4.CalcXPosValue(x0),Series4.CalcYPosValue(y0));
         LineTo(Series4.CalcXPosValue(x1),Series4.CalcYPosValue(y1));

       end;

end;     }

procedure TFrmbd2.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
   Key:=#0;
end;

procedure TFrmbd2.Edit8KeyPress(Sender: TObject; var Key: Char);
begin
    Key:=#0;
end;

procedure TFrmbd2.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
   Key:=#0;
end;

procedure TFrmbd2.Edit1Change(Sender: TObject);
begin
   edit5.Text:='1';
end;
          {
procedure TFrmbd2.Series4AfterDrawValues(Sender: TObject);
begin
              With chart2.Canvas do
        Begin
         Pen.Width:=2;
         Pen.Style:=psSolid;
         Pen.Color:=clRed;
         MoveTo(Series4.CalcXPosValue(x0),Series4.CalcYPosValue(y0));
         LineTo(Series4.CalcXPosValue(x1),Series4.CalcYPosValue(y1));

       end;

end;    }

procedure TFrmbd2.LineSeries1AfterDrawValues(Sender: TObject);
begin
     With chart2.Canvas do
        Begin
         Pen.Width:=2;
         Pen.Style:=psSolid;
         Pen.Color:=clRed;
         MoveTo(LineSeries1.CalcXPosValue(x0),LineSeries1.CalcYPosValue(y0));
         LineTo(LineSeries1.CalcXPosValue(x1),LineSeries1.CalcYPosValue(y1));

          end;
 end;         

procedure TFrmbd2.Chart2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
   var tmp : Integer;
    tmpHint : String;
    tmpX, tmpY : Double;
begin
  tmp:=LineSeries1.Clicked(x,y);
  LineSeries1.GetCursorValues(tmpX,tmpY);
  StatusBar1.SimpleText:= 'x='+  LineSeries1.GetHorizAxis.LabelValue(tmpX)+'; '+'y='+
    LineSeries1.GetVertAxis.LabelValue(tmpY)+';';
   tmpHint:= StatusBar1.SimpleText;
   Chart2.Hint:=tmphint;


end;

procedure TFrmbd2.N1Click(Sender: TObject);
   var
     s1,s2:string;
begin
   s1:=ADOQuery1jb.FieldByName('testno').AsString;   //标定编号
   if application.MessageBox('您确定真的要删除该标定编号的所有记录吗?','删除确认',MB_YesNo+
        MB_DEFBUTTON2+MB_IconQuestion+MB_SystemModal)<>IDNo then
     begin
//        showmessage('fffg');
    s2:='Delete from BYANG where  testno='+QuotedStr(s1);
          ADOQuery3.Close;
          ADOQuery3.SQL.Clear;
          ADOQuery3.SQL.Add(s2);
          ADOQuery3.ExecSQL;

          ADOQuery1jb.Close;
          ADOQuery1jb.SQL.Clear;
          ADOQuery1jb.SQL.Add('select * from BYANG order by testno  desc, bybh asc');
          ADOQuery1jb.Open;
     end;


end;

procedure TFrmbd2.N2Click(Sender: TObject);
   var
     s1,s2,sa1:string;
begin
   s1:=ADOQuery1jb.FieldByName('testno').AsString;   //标定编号
   sa1:=ADOQuery1jb.FieldByName('bybh').AsString;   //标定编号
   if application.MessageBox('您确定真的要删除当前所在行记录吗?','删除确认',MB_YesNo+
        MB_DEFBUTTON2+MB_IconQuestion+MB_SystemModal)<>IDNo then
     begin
//        showmessage('fffg');
    s2:='Delete from BYANG where  ( testno='+QuotedStr(s1)+') and ( bybh='
            +QuotedStr(sa1)+')';
          ADOQuery3.Close;
          ADOQuery3.SQL.Clear;
          ADOQuery3.SQL.Add(s2);
          ADOQuery3.ExecSQL;

          ADOQuery1jb.Close;
          ADOQuery1jb.SQL.Clear;
          ADOQuery1jb.SQL.Add('select * from BYANG order by testno  desc, bybh asc');
          ADOQuery1jb.Open;
     end;

end;

procedure TFrmbd2.DBGrid1CellClick(Column: TColumn);
begin
   edit1.Text:=ADOQuery1jb.FieldByName('testno').AsString;
end;

end.