unitauto.pas

一个多元非线性回归分析源码以及其中的公式列表

        abcList[high(abcList)].MaxV:=0;
        abcList[high(abcList)].Default:=PList[i].CAddress^;
        abcList[high(abcList)].Precision:=5;
        if PList[i].CAddress^<>0 then
          self.ClientDataSetPType.InsertRecord([
              pName,
              3,
              3,
              PList[i].CAddress^,
              PList[i].CAddress^,
              PList[i].CAddress^,
              2
              ])
        else
          self.ClientDataSetPType.InsertRecord([
              pName,
              1,
              1,
              strtofloat(self.EditMin.Text),
              strtofloat(self.EditMax.Text),
              0,
              strtofloat(self.EditPn.Text)
              ]);
      end;
    end;


    //图片界面

    self.RadioButton1.Checked:=true;
    self.RadioButton3.Checked:=false;
    self.ComboBox1.Items.Text:='';
    for i:=low(PDList) to high(PDList) do
    begin
      self.ComboBox1.Items.Text:=
        self.ComboBox1.Items.Text
        +PDList[i].CName+#13+#10;
    end;
    self.ComboBox5.Items.Text:=self.ComboBox1.Items.Text;

    if not ( PDList=nil )then
      self.ComboBox1.ItemIndex:=PDList[0].Index;
    if ExpressionType<>-1 then
    begin
      self.ComboBox6.Items.Text:='D'+inttostr(ExpressionType);
      self.ComboBox6.ItemIndex:=0;
      self.RadioButton3.Enabled:=true;
    end
    else
    begin
      self.ComboBox6.Items.Text:='';
      self.RadioButton3.Enabled:=false;
    end;


    if (self.RadioButton3.Enabled) then
    begin
      if ((high(PDList)+1)=2) then
      begin
        if PDList[0].Index=ExpressionType then
        begin
          self.ComboBox5.Items.Delete(self.ComboBox5.Items.IndexOf(PDList[0].CName));
          self.ComboBox5.ItemIndex:=0;
        end
        else
        begin
          self.ComboBox5.Items.Delete(self.ComboBox5.Items.IndexOf(PDList[1].CName));
          self.ComboBox5.ItemIndex:=0;
        end;
      end
      else if ((high(PDList)+1)>2) then
      begin
        for i:=0 to high(PDList) do
        begin
          if PDList[i].Index=ExpressionType then
            self.ComboBox5.Items.Delete(self.ComboBox5.Items.IndexOf(PDList[i].CName));
        end;
        self.ComboBox5.ItemIndex:=0;
      end
      else
      begin
        self.RadioButton3.Enabled:=false;
      end;
    end;
    //--------------


    if  Compile.GetError<>'' then
    begin
      application.MessageBox(pchar('发生错误,'+Compile.GetError),'错误：',MB_OK+MB_ICONERROR);
      //Compile.Free;
      exit;
    end
    else
    begin
      ActionStart.Enabled:=true;
      ActionPause.Enabled:=false;
      ActionContinue.Enabled:=false;
      ActionStop.Enabled:=false;
    end;
    
  except
    application.MessageBox('参数数据处理过程中发生错误!','错误:',MB_OK+MB_ICONERROR);
    //Compile.Free;
  end;
end;

procedure TfrmMain.ActionRunLineRExecute(Sender: TObject);
begin
  try
    if Application.FindComponent('frmLRGetData')=nil then
       Application.CreateForm(TfrmLRGetData, frmLRGetData);
    frmLRGetData.ShowModal;
  except
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  ActionStart.Enabled:=false;
  ActionPause.Enabled:=false;
  ActionContinue.Enabled:=false;
  ActionStop.Enabled:=false;
  self.PageControl1.ActivePageIndex:=0;

  self.ComboBox1.ItemIndex:=0;
  self.ComboBox2.ItemIndex:=0;
  self.ComboBox3.ItemIndex:=1;
  self.ImageTemp.Canvas.FillRect(Rect(0,0,self.ImageTemp.Width,self.ImageTemp.Height));
end;

procedure TfrmMain.ActionStartExecute(Sender: TObject);
var
  iCount    :integer;
begin     //开始拟合

  //get DataList
  if (ClientDataSetDataOld.RecordCount=0) or (ClientDataSetDataOld.RecordCount=1) then
  begin
    application.MessageBox('数据组数太少!','提示:',MB_OK+MB_ICONINFORMATION);
    exit;
  end;
              
  DBGridDataOld.DataSource.DataSet:=nil;
  if not (GetdData(ClientDataSetDataOld,iCount)) then
  begin
    application.MessageBox('数据读取过程中发生错误!','错误:',MB_OK+MB_ICONERROR);
    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
    exit;
  end;
  DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;

  //get abcList
  DBGridPL.DataSource.DataSet:=nil;
  if not (GetabcData(ClientDataSetPType)) then
  begin
    application.MessageBox('参数数据读取过程中发生错误!','错误:',MB_OK+MB_ICONERROR);
    DBGridPL.DataSource.DataSet:=ClientDataSetPType;
    exit;
  end; 
  DBGridPL.DataSource.DataSet:=ClientDataSetPType;

  ApWay:=self.RxCheckListBox1.CheckedIndex;
  FBWay:=self.RxCheckListBox2.CheckedIndex;

  NowTime:=windows.GetTickCount();

  try

    ActionStart.Enabled:=false;
    ActionPause.Enabled:=true;
    ActionContinue.Enabled:=false;
    ActionStop.Enabled:=true;
                                
    if not ((self.PageControl1.ActivePageIndex=2)
             or(self.PageControl1.ActivePageIndex=3)) then
      self.PageControl1.ActivePageIndex:=2;

    Timer1.Enabled:=true;
    runPause:=false;
    self.ImageTemp.Canvas.FillRect(rect(0,0,self.ImageTemp.Width,self.ImageTemp.Height));
    
    dMax:=MaxExtended;
    ActionRunExecute(nil);
  except
    application.MessageBox('开始计算时发生错误!','错误:',MB_OK+MB_ICONERROR);
  end;
end;

procedure TfrmMain.ActionSaveDataExecute(Sender: TObject);
var
  strFName   :string;
  strData    :string;
  i,j        :integer;
  //hfile      :integer;
  FF         :TextFile;
  //DataArrayP :array of TVarRec;
  //DataArray  :array of Variant;
begin
  try
    strData:='';
    self.PageControl1.ActivePageIndex:=0;
    self.SaveDataDialog.FileName:='';
    if self.SaveDataDialog.Execute then
    begin
        strFName:=SaveDataDialog.FileName;
        if SaveDataDialog.Filterindex=1 then  //*.TXT
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.TXT' then
                strFName:=strFName
            else
                strFName:=strFName+'.TXT';
        end
        else if SaveDataDialog.Filterindex=2 then   //*.XML
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.XML' then
                strFName:=strFName
            else
                strFName:=strFName+'.XML';
        end
        else if SaveDataDialog.Filterindex=3 then   //*.XML  UTF8
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.XML' then
                strFName:=strFName
            else
                strFName:=strFName+'.XML';
        end
        else if SaveDataDialog.Filterindex=4 then   //*.cds
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.CDS' then
                strFName:=strFName
            else
                strFName:=strFName+'.cds';
        end;
        if FileExists(strFName) then
        begin
          if not ( application.MessageBox(pchar('文件 "'+strFName+'" 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;     
          DeleteFile(strFName);
        end;

        DBGridDataOld.DataSource.DataSet:=nil;
        if ifin(UpperCase(copy(strFName,length(strFName)-3,4)),['.XML','.CDS']) then
        begin
          ClientDataSetDataOldTemp.First;
          while not (ClientDataSetDataOldTemp.Eof) do
            ClientDataSetDataOldTemp.Delete;
         // setlength(DataArray,DataLength);
         // setlength(DataArrayP,DataLength);
         // for i:=0 to DataLength-1 do
         //   DataArrayP[i].VVariant:=@DataArray[i];
          for i:=0 to DataMaxIndex-1 do
          begin
            ClientDataSetData[i].Last;
            while not(ClientDataSetData[i].Bof) do
            begin
              ClientDataSetDataOldTemp.Insert;
              for j:=0 to DataLength-1 do
              begin
                ClientDataSetDataOldTemp.fieldbyName('d'+inttostr(j)).AsVariant:=ClientDataSetData[i].fieldbyName('d'+inttostr(j)).AsVariant;
                //DataArray[j]:=ClientDataSetData[i].fieldbyName('d'+inttostr(j)).AsVariant;
              end;
              //ClientDataSetDataOldTemp.InsertRecord(DataArrayP);
              ClientDataSetData[i].Prior;
            end;
            ClientDataSetData[i].First;
            ClientDataSetDataOldTemp.InsertRecord([null,null,MinComp,MaxDouble]);  //分隔标记
          end;
        end
        else   //*.TXT
        begin
          strData:='<?TXT Regress1.0?>'+#13+#10;
          for i:=0 to DataMaxIndex-1 do
          begin
            strData:=strData+'<>'+#13+#10;
            strData:=strData+GetDataAsStr(ClientDataSetData[i]);
          end;
        end;
        if (UpperCase(copy(strFName,length(strFName)-3,4))='.XML')
          and(SaveDataDialog.Filterindex=3)then
          ClientDataSetDataOldTemp.SaveToFile(strFName,dfXMLUTF8)
        else if UpperCase(copy(strFName,length(strFName)-3,4))='.XML' then
          ClientDataSetDataOldTEmp.SaveToFile(strFName,dfXML)
        else if UpperCase(copy(strFName,length(strFName)-3,4))='.CDS' then
          ClientDataSetDataOldTemp.SaveToFile(strFName,dfBinary)
        else //*.TXT  or *.*
        begin
          AssignFile(FF,strFname);
          Rewrite(FF);
          Write(FF, strData);
          CloseFile(FF);
          strData:='';
        end;
        DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
        
        ClientDataSetDataOldTemp.FileName:='';
        ClientDataSetDataOldTemp.First;
        while not (ClientDataSetDataOldTemp.Eof) do
          ClientDataSetDataOldTemp.Delete;
    end;
  except
    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
    ClientDataSetDataOld.Active:=true;
    application.MessageBox(Pchar('保存数据时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmMain.ActionOpenDataExecute(Sender: TObject);
//type
//  TarrayofTVarRec=array of TVarRec ;
var
  FName   :string;
  strTemp :string;     
  Fr      :TextFile;
  ch1,ch2,ch3,ch4,ch5  :char;
  tempBoolean :Boolean;

  
  procedure OpenCdsXML();
  var
    i,j     :integer;
  begin     
    ClientDataSetDataOldTemp.LoadFromFile(self.OpenDataDialog.FileName);
    ClientDataSetDataOldTemp.FileName:='';
    ClientDataSetDataOldTemp.Active:=true;

    for i:=0 to DataMaxIndex-1 do
    begin
      ClientDataSetData[i].First;
      while not (ClientDataSetData[i].Eof) do
        ClientDataSetData[i].Delete;
    end;

    DBGridDataOld.DataSource.DataSet:=nil;
    ClientDataSetDataOldTEmp.First ;
    i:=0;
    while not (ClientDataSetDataOldTEmp.Eof ) do
    begin
      if (ClientDataSetDataOldTemp.fieldByName('d0').Value=null)
        and (ClientDataSetDataOldTemp.fieldByName('d1').Value=null)
        and (ClientDataSetDataOldTemp.fieldByName('d2').Value=MinComp)
        and (ClientDataSetDataOldTemp.fieldByName('d3').Value=MaxDouble) then
      begin
        i:=i+1;
      end
      else
      begin
        ClientDataSetData[i].Insert;
        for j:=0 to min(DataLength,ClientDataSetDataOldTEmp.FieldDefs.Count)-1 do
          ClientDataSetData[i].fieldByName('d'+inttostr(j)).Value:=ClientDataSetDataOldTEmp.fieldByName('d'+inttostr(j)).Value;
        ClientDataSetData[i].Post;
      end;
      ClientDataSetDataOldTemp.Next ;
    end;
    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
    ClientDataSetDataOld.First;

    ClientDataSetDataOldTEmp.First;
    while not (ClientDataSetDataOldTEmp.Eof) do
      ClientDataSetDataOldTemp.Delete;
  end;

  procedure OpenTXT();
  var
    FF     :TextFile;
    s      :string;
    i,j    :integer;
  begin
    for i:=0 to DataMaxIndex-1 do
    begin
      ClientDataSetData[i].First;
      while not (ClientDataSetData[i].Eof) do
        ClientDataSetData[i].Delete;
    end;
    while not (ClientDataSetDataOldTemp.Eof) do
      ClientDataSetDataOldTemp.Delete;

    DBGridDataOld.DataSource.DataSet:=nil;

    AssignFile(FF,Fname);
    Reset(FF);
    Readln(FF, S);
    i:=-1;
    while not eof(ff) do
    begin
      Readln(FF, S);
      if s='<>' then
      begin
        if i>=0 then
        begin
          ClientDataSetDataOldTemp.First;
          while not (ClientDataSetDataOldTemp.Eof) do
          begin
            ClientDataSetData[i].Insert;
            for j:=0 to DataLength-1 do
              ClientDataSetData[i].fieldByName('d'+inttostr(j)).Value:=ClientDataSetDataOldTemp.fieldByName('d'+inttostr(j)).Value;
            ClientDataSetData[i].Post;
            ClientDataSetDataOldTemp.Delete;
          end;
        end;
        i:=i+1;
      end
      else
      begin
        ClientDataSetDataOldTemp.Insert;
        for j:=0 to DataLength-1 do
        begin
          ClientDataSetDataOldTemp.fieldByName('d'+inttostr(j)).Value:=GetStrFeildValue(s);
        end;