unitauto.pas

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

    application.ProcessMessages;
  except
    //
  end;
end;

procedure TfrmMain.EditMinKeyPress(Sender: TObject; var Key: Char);
begin
    Key:=upcase(Key);
    //showmessage(inttostr(byte(key)));
    case Key of
        '0','1','2','3','4','5','6','7','8','9': Key:=Key;
        'E','.','-','+': Key:=Key;
        #8,#9,#13: Key:=Key;
        else Key:=#0;
    end;
end;

procedure TfrmMain.EditPnKeyPress(Sender: TObject; var Key: Char);
begin
    Key:=upcase(Key);
    //showmessage(inttostr(byte(key)));
    case Key of
        '0','1','2','3','4','5','6','7','8','9': Key:=Key;
         #8,#9,#13: Key:=Key;
        else Key:=#0;
    end;
end;

procedure TfrmMain.ActionRefreshPictureExecute(Sender: TObject);
var
  xMin,xMax,yMin,yMax      :extended; //值范围
  pxMin,pxMax,pyMin,pyMax  :integer; //屏幕范围
  dIndex0,dIndex1          :integer;
  dVvar                    :array of extended; //差值
  dDatax,dDatay            :array of extended; //横轴
  X,Y                      :integer;
  i,k                      :integer;
begin
  application.ProcessMessages;
  if (self.PageControl1.ActivePageIndex=3) then
  begin

    //准备画图
    try
      PPXMin:=0;
      PPYMin:=0;
      PPXMax:=0;
      PPYMax:=0;

      pxMin:=0;
      pyMin:=0;
      pxMax:=0;
      pyMax:=0;

      xMin:=0;
      yMin:=0;
      xMax:=0;
      yMax:=0;

      setlength(dVvar,high(dData)+1);
      GetSubValue(abcList,abcMax,dVvar);

      self.ImageTemp.Canvas.Pen.Width:=1;
      self.ImageTemp.Canvas.Brush.Color:=self.ColorComboBox1.ColorValue;
      self.ScrollBox1.Color:=self.ColorComboBox1.ColorValue;
      self.ImageTemp.Canvas.FillRect(rect(0,0,self.ImageTemp.Picture.Width-1,self.ImageTemp.Picture.Height-1));


      if self.RadioButton1.Checked then   //差方图
      begin
        pxMin:=self.ImageTemp.Picture.Bitmap.Width div 10;
        pxMax:=self.ImageTemp.Picture.Bitmap.Width*9 div 10;
        pyMin:=self.ImageTemp.Picture.Bitmap.Height*3 div 7;
        pyMax:=self.ImageTemp.Picture.Bitmap.Height*4 div 7;

        dIndex0:=strtoint(copy(self.ComboBox1.Text,2,length(self.ComboBox1.Text)-1));
        setlength(dDatax,high(dData)+1);
        for i:=0 to high(dData) do dDatax[i]:=dData[i,dIndex0] ;
        xMin:=MinInArray(dDatax);
        xMax:=MaxInArray(dDatax);
        yMin:=MinInArray(dVvar);
        yMax:=MaxInArray(dVvar);
        if xMin=xMax then
        begin
          xMin:=xMin-1;
          xMax:=xMax+1;
        end;
        if yMin=yMax then
        begin
          yMin:=yMin-1;
          yMax:=yMax+1;
        end;
        yMax:=max(abs(0-yMin),abs(yMax-0));

        self.ImageTemp.Canvas.Pen.Color:=self.ColorComboBox3.ColorValue;
        self.ImageTemp.Canvas.PenPos:=point(pxMin,(pyMax-pyMin) div 2+PyMin );
        self.ImageTemp.Canvas.LineTo(pxMax,(pyMax-pyMin) div 2+PyMin );

        for i:=0 to high(dDatax) do
        begin
          X:=trunc((dDatax[i]-xMin)/(xMax-xMin)*(PxMax-PxMin)+pxMin);
          y:=trunc(pyMax-(pyMax-pyMin)/2*(yMax-dVvar[i])/(yMax+1e-1000));
          self.ImageTemp.Canvas.Pixels[X,Y]:=self.ColorComboBox2.ColorValue;
          self.ImageTemp.Canvas.Pixels[X+1,Y]:=self.ColorComboBox2.ColorValue;
          self.ImageTemp.Canvas.Pixels[X+1,Y+1]:=self.ColorComboBox2.ColorValue;
          self.ImageTemp.Canvas.Pixels[X,Y+1]:=self.ColorComboBox2.ColorValue;
        end;

      end
      else if self.RadioButton3.Checked then  //平面图
      begin
        pxMin:=self.ImageTemp.Picture.Bitmap.Width div 10;
        pxMax:=self.ImageTemp.Picture.Bitmap.Width*9 div 10;
        pyMin:=self.ImageTemp.Picture.Bitmap.Height*9 div 10;
        pyMax:=self.ImageTemp.Picture.Bitmap.Height div 10;

        dIndex0:=strtoint(copy(self.ComboBox5.Text,2,length(self.ComboBox5.Text)-1));
        dIndex1:=strtoint(copy(self.ComboBox6.Text,2,length(self.ComboBox6.Text)-1));
        setlength(dDatax,high(dData)+1);
        for i:=0 to high(dData) do dDatax[i]:=dData[i,dIndex0] ;
        xMin:=MinInArray(dDatax);
        xMax:=MaxInArray(dDatax);
        setlength(dDatay,high(dData)+1);
        for i:=0 to high(dData) do dDatay[i]:=dData[i,dIndex1] ;
        yMin:=MinInArray(dDatay);
        yMax:=MaxInArray(dDatay);
        if xMin=xMax then
        begin
          xMin:=xMin-1;
          xMax:=xMax+1;
        end;
        if yMin=yMax then
        begin
          yMin:=yMin-1;
          yMax:=yMax+1;
        end;

        if ((high(PDList)+1)=2) then
        begin
          k:=self.ImageTemp.Picture.Bitmap.Width;
          self.ImageTemp.Canvas.Pen.Color:=self.ColorComboBox3.ColorValue;
            x:=trunc(0/k*(PxMax-PxMin)+pxMin);
            if ExpressionTypeLR=0 then
              y:=trunc(   (
                           -getSubValue(
                           abcList,abcMax,
                           0/k*(xMax-xMin)+xMin,dindex0,dindex1
                                       )-yMin
                           )/(yMax-yMin)*(PyMax-PyMin)+pyMin
                      )
            else
              y:=trunc(   (
                           getSubValue(
                           abcList,abcMax,
                           0/k*(xMax-xMin)+xMin,dindex0,dindex1
                                       )-yMin
                           )/(yMax-yMin)*(PyMax-PyMin)+pyMin
                      );
          self.ImageTemp.Canvas.PenPos:=point(x,y);
          for i:=1 to k do
          begin
            x:=trunc(i/k*(PxMax-PxMin)+pxMin);
            if ExpressionTypeLR=0 then
              y:=trunc(   (
                           -getSubValue(
                           abcList,abcMax,
                           i/k*(xMax-xMin)+xMin,dindex0,dindex1
                                       )-yMin
                           )/(yMax-yMin)*(PyMax-PyMin)+pyMin
                      )
            else
              y:=trunc(   (
                           getSubValue(
                           abcList,abcMax,
                           i/k*(xMax-xMin)+xMin,dindex0,dindex1
                                       )-yMin
                           )/(yMax-yMin)*(PyMax-PyMin)+pyMin
                      );
              self.ImageTemp.Canvas.LineTo(x,y);
            end;
        end
        else
        begin
          self.ImageTemp.Canvas.Pen.Color:=self.ColorComboBox3.ColorValue;
          x:=trunc((dDatax[0]-xMin)/(xMax-xMin)*(PxMax-PxMin)+pxMin);;
          if ExpressionTypeLR=0 then
            y:=trunc((dDatay[0]-dVvar[0]-yMin)/(yMax-yMin)*(PyMax-PyMin)+pyMin)
          else
            y:=trunc((dDatay[0]+dVvar[0]-yMin)/(yMax-yMin)*(PyMax-PyMin)+pyMin);
          self.ImageTemp.Canvas.PenPos:=point(x,y);

          for i:=1 to high(dDataX) do
          begin
            X:=trunc((dDatax[i]-xMin)/(xMax-xMin)*(PxMax-PxMin)+pxMin);
            if ExpressionTypeLR=0 then
              y:=trunc((dDatay[i]-dVvar[i]-yMin)/(yMax-yMin)*(PyMax-PyMin)+pyMin)
            else
              y:=trunc((dDatay[i]+dVvar[i]-yMin)/(yMax-yMin)*(PyMax-PyMin)+pyMin);            self.ImageTemp.Canvas.LineTo(x,y);
          end;
        end;

        for i:=high(dDatax) downto 0 do         //点
        begin
          X:=trunc((dDatax[i]-xMin)/(xMax-xMin)*(PxMax-PxMin)+pxMin);
          y:=trunc((dDatay[i]-yMin)/(yMax-yMin)*(PyMax-PyMin)+pyMin);
          self.ImageTemp.Canvas.Pixels[X,Y]:=self.ColorComboBox2.ColorValue;
          self.ImageTemp.Canvas.Pixels[X+1,Y]:=self.ColorComboBox2.ColorValue;
          self.ImageTemp.Canvas.Pixels[X+1,Y+1]:=self.ColorComboBox2.ColorValue;
          self.ImageTemp.Canvas.Pixels[X,Y+1]:=self.ColorComboBox2.ColorValue;
        end;
      end;

      ImageMain.Picture.Assign(ImageTemp.Picture);

      PPXMin:=pxMin;
      PPYMin:=pyMin;
      PPXMax:=pxMax;
      PPYMax:=pyMax;

      PxXMin:=xMin;
      PyYMin:=yMin;
      PxXMax:=xMax;
      PyYMax:=yMax;


    except
      //
    end;
  end;
end;

procedure TfrmMain.PageControl1Change(Sender: TObject);
begin
  try
    RadioButton1Click(Sender);
    if(ActionPause.Enabled)or(ActionContinue.Enabled)or(ActionStop.Enabled)then
    begin
      case self.PageControl1.ActivePageIndex of
        2: ActionRefreshResultExecute(nil);
        3: ActionRefreshPictureExecute(nil);
      end;
    end;
  except
    //
  end;
end;

procedure TfrmMain.RadioButton1Click(Sender: TObject);
begin
  if RadioButton1.Checked then
  begin
    self.ComboBox1.Enabled:=true;
    self.EditZong.Enabled:=true;
    self.Label1.Enabled:=true;
    self.Label2.Enabled:=true;
  end
  else
  begin
    self.ComboBox1.Enabled:=false;
    self.EditZong.Enabled:=false;
    self.Label1.Enabled:=false;
    self.Label2.Enabled:=false;
  end;

  if RadioButton3.Checked then
  begin
    self.ComboBox5.Enabled:=true;
    self.ComboBox6.Enabled:=true;
    self.Label6.Enabled:=true;
    self.Label7.Enabled:=true;
  end
  else
  begin
    self.ComboBox5.Enabled:=false;
    self.ComboBox6.Enabled:=false;
    self.Label6.Enabled:=false;
    self.Label7.Enabled:=false;
  end;

end;

procedure TfrmMain.ScrollBox1Resize(Sender: TObject);
begin
  self.ImageTemp.Picture.Bitmap.Width:=self.ScrollBox1.Width;
  self.ImageTemp.Picture.Bitmap.Height:=self.ScrollBox1.Height;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  try
    if self.ToolButton12.Enabled=true then
    begin
      ActionRefreshResultExecute(Sender);
      ActionRefreshPictureExecute(Sender);
    end;
  except
    //
  end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  RunExe('公式列表.txt');
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
var
  Compilation   : TCompile;
  dStr          : string;
  x             : Extended;
  p             : array of PExtended;
  px            : array of Extended;
  i             : integer;                    
  PList  :array of TParameterList;

begin
    setlength(p,DataLength);
    setlength(px,DataLength);
   { if self.EditData.Text='' then
    begin
      application.MessageBox(Pchar('   请填入表达式。  '),'说明：',MB_ICONINFORMATION+MB_OK);
      exit;
    end;}
    dStr:=self.ComboBox4.Text;
    if dStr='' then
    begin
      application.MessageBox(Pchar('   请选择要处理的数据列。   '),'说明：',MB_ICONINFORMATION+MB_OK);
      exit;
    end
    else if not IFInDCount(dStr) then
    begin
      application.MessageBox(Pchar('   指定的数据列 " '+dStr+' " 没有找到！   '),'警告：',MB_ICONWARNING+MB_OK);
      exit;
    end
    else
    begin
      if self.CheckBoxEditDataQuestion.Checked then
      begin
        if application.MessageBox(Pchar('   确实要对 " '+dStr+' " 列数据进行处理吗?   '),'确认：',
          MB_ICONQUESTION+MB_YesNo)=ID_NO then
          exit;
      end;
    end;

    Compilation:=TCompile.Create;
  try
    Compilation.SetText(self.EditData.Text);
    if Compilation.GetError<>'' then
    begin
      application.MessageBox(Pchar( '  表达式错误，'+Compilation.GetError),'出错：',MB_ICONERROR+MB_OK);
      Compilation.Free;
      exit;
    end;
    setlength(PList,Compilation.GetParameterCount);
    Compilation.GetParameterList(PList);
    for i:=0 to Compilation.GetParameterCount-1 do
    begin
      if (PList[i].IfConst=false) then
      begin
        if ((PList[i].CName<>'&PI')and(PList[i].CName<>'&E')) and IFInDCount(copy(PList[i].CName,2,length(PList[i].CName)-1))<>true then
        begin
          application.MessageBox(Pchar( '  有不识别的标识符!  '+'" '+copy(PList[i].CName,2,length(PList[i].CName)-1)+' "'),'警告：',MB_ICONWARNING+MB_OK);
          Compilation.Free;
          exit;
        end;
      end;
    end;

    for i:=0 to DataLength-1 do
      p[i]:=Compilation.GetParameterAddress('d'+inttostr(i));

    DBGridDataOld.DataSource.DataSet:=nil;
    ClientDataSetDataOld.First;
    while not (ClientDataSetDataOld.eof) do
    begin
      for i:=0 to DataLength-1 do
        px[i]:=ClientDataSetDataOld.fieldByName('d'+inttostr(i)).AsFloat;
      for i:=0 to DataLength-1 do
        if not (P[i]=nil) then  P[i]^:=px[i];
      ClientDataSetDataOld.Edit;
      if self.EditData.Text<>'' then
      begin
        Compilation.GetValue(x);
        ClientDataSetDataOld.fieldByName(dstr).AsFloat:=x;
      end
      else
        ClientDataSetDataOld.fieldByName(dstr).AsVariant:=null;
      //ClientDataSetDataOld.Post;
      ClientDataSetDataOld.Next;
    end;
    ClientDataSetDataOld.First;
    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;

    self.ListBoxHistory.Items.Insert(0,dStr+'='+self.EditData.Text);

    Compilation.Free;
  except
    application.MessageBox(Pchar( '  计算时发生错误。  '),'出错：',MB_ICONERROR+MB_OK);
    Compilation.Free;  
    DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
  end;
end;

procedure TfrmMain.BitBtn3Click(Sender: TObject);
var
  xMin,xMax,yMin,yMax      :extended; //值范围
  pxMin,pxMax,pyMin,pyMax  :integer; //屏幕范围
  i,iCount                 :integer;