unitauto.pas

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

        ClientDataSetDataOldTemp.Post;
      end;
    end;
    CloseFile(FF);

    i:=DataMaxIndex-1;
    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;

    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
    ClientDataSetDataOld.First;


  end;

begin
  try
    self.PageControl1.ActivePageIndex:=0;
    self.OpenDataDialog.FileName:='';   
    if self.OpenDataDialog.Execute then
    begin
        FName:=self.OpenDataDialog.FileName;
        if FName<>'' then
        begin
            DBGridDataOld.DataSource.DataSet:=nil;
            if FileExists(FName)  then
            begin
              if (length(FName)>4) and
                 ( (uppercase(copy(FName,length(fname)-4+1,4))='.XML')
                 or(uppercase(copy(FName,length(fname)-4+1,4))='.CDS') ) then
              begin
                OpenCdsXML();
              end
              else
              begin
                strTemp:='     ';
                AssignFile(Fr, Fname);
                Reset(Fr);
                Read(Fr,ch1);
                Read(Fr,ch2);
                Read(Fr,ch3);
                Read(Fr,ch4);
                Read(Fr,ch5);
                CloseFile(Fr);
                strTemp:=ch1+ch2+ch3+ch4+ch5;
                setlength(strTemp,5);
                strTemp:=uppercase(strTemp);
                if strTemp='<?XML' then
                  OpenCdsXML()
                else if strTemp='<?TXT' then
                begin
                  OpenTXT();
                end
                else
                  application.MessageBox(Pchar('  不识别的文件格式!  '),'警告：',MB_ICONWARNING);
              end;
            end
            else
                application.MessageBox(Pchar('  文件没有找到!  '),'警告：',MB_ICONWARNING);
            DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
            tempBoolean:=true;
            TabDataIndex.TabIndex:=0;
            TabDataIndexChange(sender,0,tempBoolean);
        end;
    end;
  except
    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
    application.MessageBox(Pchar('  打开文件时出现错误。  '),'出错：',MB_ICONERROR);
    ClientDataSetDataOld.Active:=true;
  end;
end;

procedure TfrmMain.ActionOpenPExecute(Sender: TObject);
var
  skey  :string;
begin
  try
    self.PageControl1.ActivePageIndex:=1;
    self.OpenPTDialog.FileName:='';
    if self.OpenPTDialog.Execute then
    begin
        if self.OpenPTDialog.FileName<>'' then
        begin
            if FileExists(self.OpenPTDialog.FileName)  then
            begin          
                ClientDataSetPTypeopenTemp.First;
                while not (ClientDataSetPTypeopenTemp.Eof) do
                  ClientDataSetPTypeopenTemp.Delete;
                self.ClientDataSetPTypeOpenTemp.LoadFromFile(self.OpenPTDialog.FileName);
                self.ClientDataSetPTypeOpenTemp.FileName:='';
                self.ClientDataSetPTypeOpenTemp.Active:=true;
                //
                DBGridPL.DataSource.DataSet:=nil;
                ClientDataSetPTypeopenTemp.First;
                while not(ClientDataSetPTypeopenTemp.eof) do
                begin
                  sKey:=ClientDataSetPTypeopenTemp.fieldByName('F_TP_NAME').AsString;
                  ClientDataSetPType.First;
                  while not(ClientDataSetPType.eof) do
                  begin
                     if sKey=ClientDataSetPType.fieldByName('F_TP_NAME').AsString then
                     begin
                       ClientDataSetPType.Edit;
                       ClientDataSetPType.FieldByName('F_TP_ZF_NAME').AsString:=ClientDataSetPTypeopenTemp.FieldByName('F_TP_ZF_NAME').AsString;
                       ClientDataSetPType.FieldByName('F_TP_ZF_ID').AsInteger:=ClientDataSetPTypeopenTemp.FieldByName('F_TP_ZF_ID').AsInteger;
                       ClientDataSetPType.FieldByName('F_TP_MIN').AsFloat:=ClientDataSetPTypeopenTemp.FieldByName('F_TP_MIN').AsFloat;
                       ClientDataSetPType.FieldByName('F_TP_MAX').AsFloat:=ClientDataSetPTypeopenTemp.FieldByName('F_TP_MAX').AsFloat;
                       ClientDataSetPType.FieldByName('F_TP_DEFAULT').AsFloat:=ClientDataSetPTypeopenTemp.FieldByName('F_TP_DEFAULT').AsFloat;
                       ClientDataSetPType.FieldByName('F_TP_Precision').AsInteger:=ClientDataSetPTypeopenTemp.FieldByName('F_TP_Precision').AsInteger;
                       ClientDataSetPType.Last;
                     end;
                     ClientDataSetPType.Next;
                  end;
                  ClientDataSetPTypeopenTemp.Next;
                end;
                //
                ClientDataSetPType.First;
                DBGridPL.DataSource.DataSet:=ClientDataSetPType;
                ClientDataSetPTypeopenTemp.First;
                while not (ClientDataSetPTypeopenTemp.Eof) do
                  ClientDataSetPTypeopenTemp.Delete;
            end
            else
                application.MessageBox(Pchar('文件没有找到!'),'警告：',MB_ICONWARNING);
        end;
    end;
  except
    application.MessageBox(Pchar('打开参数文件时出现错误。'),'出错：',MB_ICONERROR); 
    self.ClientDataSetPType.Active:=true;
  end;
end;

procedure TfrmMain.ActionSavePExecute(Sender: TObject);
var strFName   :string;
begin
  try
    self.PageControl1.ActivePageIndex:=1;
    self.SavePTDialog.FileName:='';
    if self.SavePTDialog.Execute then
    begin
        strFName:=SavePTDialog.FileName;
        if SavePTDialog.Filterindex=1 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.TXT' then
                strFName:=strFName
            else
                strFName:=strFName+'.TXT';
        end
        else if SavePTDialog.Filterindex=2 then
        begin
            strFName:=strFName;
        end;
        if FileExists(strFName) then
        begin
          if not ( application.MessageBox(pchar('文件 "'+strFName+'" 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;
          DeleteFile(strFName);
        end;
        self.ClientDataSetPType.SaveToFile(strFName,dfXML);
        self.ClientDataSetPType.FileName:='';
        self.ClientDataSetPType.Active:=true;
    end;
  except
    self.ClientDataSetPType.FileName:='';
    self.ClientDataSetPType.Active:=true;
    application.MessageBox(Pchar('保存参数数据时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;



procedure TfrmMain.ActionSaveResultExecute(Sender: TObject);
var strFName   :string;
begin
  try
    self.PageControl1.ActivePageIndex:=2;
    self.SaveResultDialog.FileName:='';
    if self.SaveResultDialog.Execute then
    begin
        strFName:=SaveResultDialog.FileName;
        if SaveResultDialog.Filterindex=1 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.TXT' then
                strFName:=strFName
            else
                strFName:=strFName+'.TXT';
        end
        else if SaveResultDialog.Filterindex=2 then
        begin
            strFName:=strFName;
        end;
        if FileExists(strFName) then
        begin
            if not ( application.MessageBox(pchar('文件 "'+strFName+'" 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;   
          DeleteFile(strFName);
        end;
        self.ValueListEditorSaveTemp.Strings.Text:=
             self.ValueListEditorPResult.Strings.Text
            +self.ValueListEditorVResult.Strings.Text;
        self.ValueListEditorSaveTemp.Strings.SaveToFile(strFName);
        self.ValueListEditorSaveTemp.Strings.Text:='';
    end;
  except
    application.MessageBox(Pchar('保存结果数据时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmMain.ActionSavePictureExecute(Sender: TObject);
var jg          :Tjpegimage;
    strFName    :string;
    DBImagePIC  :Timage;
begin
    self.PageControl1.ActivePageIndex:=3;
    application.ProcessMessages;
    DBImagePIC:=self.ImageTemp;
    if (DBImagePIC.Picture=nil) then
    begin
        application.MessageBox(pchar('图片框中没有图片,不能完成保存任务!'),' 提示：',MB_OK+MB_ICONINFORMATION);
        exit;
    end;
  try
    SavePictureDialog.FileName:='';
    if SavePictureDialog.Execute then
    begin
        strFName:=SavePictureDialog.FileName;
        if SavePictureDialog.Filterindex=1 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.BMP' then
                strFName:=strFName
            else
                strFName:=strFName+'.bmp';
        end 
        else if SavePictureDialog.Filterindex=2 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.JPG' then
                strFName:=strFName
            else
                strFName:=strFName+'.jpg';
        end
        else if SavePictureDialog.Filterindex=3 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.GIF' then
                strFName:=strFName
            else
                strFName:=strFName+'.gif';
        end
        else
            strFName:=strFName+'.bmp';
        if FileExists(strFName) then
        begin
            if not ( application.MessageBox(pchar('文件 “'+strFName+'” 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;   
          DeleteFile(strFName);
        end;
        if UpperCase(copy(strFName,length(strFName)-3,4))='.BMP' then
        begin
            DBImagePIC.Picture.Bitmap.SaveToFile(strFName);
        end
        else if UpperCase(copy(strFName,length(strFName)-3,4))='.JPG' then
        begin
            Jg := TJPEGImage.Create;
            jg.CompressionQuality:=82;
            jg.Assign(DBImagePIC.Picture.Bitmap);
            jg.SaveToFile(strFName);
            jg.Free;
        end
        else  if UpperCase(copy(strFName,length(strFName)-3,4))='.GIF' then
        begin
            Rx_To_GIF.Image.Assign(DBImagePIC.Picture.Bitmap);
            Rx_To_GIF.Image.SaveToFile(strFName);
        end;
        //application.MessageBox(pchar('文件“'+strFName+'”保存完成！'),'说明：',MB_OK+MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('保存图形时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin                           
  dMax:=MaxExtended;
  FBWay:=self.RxCheckListBox2.CheckedIndex;
end;

procedure TfrmMain.ActionPauseExecute(Sender: TObject);
begin
  ActionStart.Enabled:=false;
  ActionPause.Enabled:=false;
  ActionContinue.Enabled:=true;
  ActionStop.Enabled:=true;
  runPause:=true;
  Timer1.Enabled:=false;
end;

procedure TfrmMain.ActionContinueExecute(Sender: TObject);
begin
  ActionStart.Enabled:=false;
  ActionPause.Enabled:=true;
  ActionContinue.Enabled:=false;
  ActionStop.Enabled:=true;
  runPause:=false;
  Timer1.Enabled:=true;
end;

procedure TfrmMain.ActionStopExecute(Sender: TObject);
begin
  ActionStart.Enabled:=true;
  ActionPause.Enabled:=false;
  ActionContinue.Enabled:=false;
  ActionStop.Enabled:=false;
  Timer1.Enabled:=false;
  runPause:=false;
  application.ProcessMessages;
  NowTime:=windows.GetTickCount();
  application.ProcessMessages;
end;

procedure TfrmMain.ClientDataSetPTypeBeforePost(DataSet: TDataSet);
begin
  if ClientDataSetPType.FieldByName('F_TP_NAME').AsString='' then
  begin
    ClientDataSetPType.Cancel;
    ABORT;
  end;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if(ActionPause.Enabled)or(ActionContinue.Enabled)or(ActionStop.Enabled)then
  begin
    IF application.MessageBox(Pchar(#13+#10+'  请先停止正在进行的任务!        '+#13+#10+#13+#10+'    一定要退出程序吗?'+#13+#10),'提示:',MB_YesNo+MB_ICONWARNING)=ID_Yes then
    begin
      ActionStopExecute(sender);
      application.ProcessMessages;
      CanClose:=true;
    end
    else
      CanClose:=false;
  end
  else
    CanClose:=true;

  if canClose then
  begin
    self.Enabled:=false;
    self.Hide;
  end;
     
end;

procedure TfrmMain.ActionExitExecute(Sender: TObject);
begin
  self.Close;
end;

procedure TfrmMain.ActionAboutExecute(Sender: TObject);
begin
  try
    if Application.FindComponent('frmFlash')=nil then
       Application.CreateForm(TfrmFlash, frmFlash);
    frmFlash.Button1.Visible:=true;
    frmFlash.TimerClose.Enabled:=false;
    frmFlash.Show;
  except
  end;
end;

procedure TfrmMain.ActionRunExecute(Sender: TObject);
begin
  //调用拟合方法函数
  RunOptimize();
  ActionStopExecute(nil);
end;

procedure TfrmMain.ActionRefreshResultExecute(Sender: TObject);
var
  str :string;
  i   :integer;
  dx  :extended;
  MyAbcList :array of TabcList;
begin               
  if self.PageControl1.ActivePageIndex<>2 then exit;
  try
    str:='';
    for i:=high(abcMax)  downto low(abcMax) do
    begin
      str:=str+abcList[i].CName+'=';
      str:=str+floattostr(abcMax[i])+#13+#10;
    end;
    self.ValueListEditorPResult.Strings.Text:=str;
    //str:=self.RxCheckListBox2.Items.Strings[FBWay];
    //self.ValueListEditorVResult.Values[self.RxCheckListBox2.Items.Strings[FBWay]]:=floattostr(dMax);
    setlength(MyabcList,high(abcList)+1);
    for i:=0 to high(abcList) do MyabcList[i]:=abcList[i];
    for i:=0 to high(myabcList) do MyabcList[i].Default:=abcMax[i];
    for i:=0 to self.RxCheckListBox2.Items.Count-1 do
    begin
       dx:=GetFBValue(MyabcList,i);
       self.ValueListEditorVResult.Values[copy(self.RxCheckListBox2.Items.Strings[i],1,length(self.RxCheckListBox2.Items.Strings[i])-4)]:=floattostr(dx);
    end;
    self.Refresh;