📄 unitauto.pas

📁 一个多元非线性回归分析源码以及其中的公式列表
💻 PAS
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
  dIndexX,dIndexY          :string;
  dDatax,dDatay            :array of extended; //横轴
  X,Y                      :integer;
begin
    PicxMin:=0;
    PicxMax:=0;
    PicyMin:=0;
    PicyMax:=0;

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

    pxMin:=self.ImageXY.Picture.Bitmap.Width div 10;
    pxMax:=self.ImageXY.Picture.Bitmap.Width*9 div 10;
    pyMin:=self.ImageXY.Picture.Bitmap.Height*9 div 10;
    pyMax:=self.ImageXY.Picture.Bitmap.Height div 10;

    dIndexX:=self.ComboBox2.Text;
    dIndexY:=self.ComboBox3.Text;

    ClientDataSetDataOld.Last;
    ClientDataSetDataOld.First;
    iCount:=ClientDataSetDataOld.RecordCount;
    if not (iCount<1) then
    begin
      setlength(dDatax,iCount);
      setlength(dDatay,iCount);
      DBGridDataOld.DataSource.DataSet:=nil;
      i:=0;
      while not (ClientDataSetDataOld.Eof) do
      begin
        dDataX[i]:=ClientDataSetDataOld.fieldByName(dIndexX).AsFloat;
        dDataY[i]:=ClientDataSetDataOld.fieldByName(dIndexY).AsFloat;
        ClientDataSetDataOld.Next;
        i:=i+1;
      end;
      ClientDataSetDataOld.First;    
      DBGridDataOld.DataSource.DataSet:=ClientDataSetDataOld;
    end
    else
    begin
      exit;
    end;

    xMin:=MinInArray(dDatax);
    xMax:=MaxInArray(dDatax);
    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;

    PicxMin:=xMin;
    PicxMax:=xMax;
    PicyMin:=yMin;
    PicyMax:=yMax;

    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.ImageXY.Canvas.Pixels[X,Y]:=self.ColorComboBox2.ColorValue;
      self.ImageXY.Canvas.Pixels[X+1,Y]:=self.ColorComboBox2.ColorValue;
      self.ImageXY.Canvas.Pixels[X+1,Y+1]:=self.ColorComboBox2.ColorValue;
      self.ImageXY.Canvas.Pixels[X,Y+1]:=self.ColorComboBox2.ColorValue;
    end;
  except
    //
  end;
end;

procedure TfrmMain.ComboBoxFunctionEnter(Sender: TObject);
begin
  try
   self.ComboBoxFunction.Items.LoadFromFile(GetFileNamePath(application.ExeName)+'公式列表.txt');
  except
    //
  end;
end;

procedure TfrmMain.ValueListEditorVResultDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  if  copy(self.RxCheckListBox2.Items.Strings[FBWay],1,length(self.RxCheckListBox2.Items.Strings[FBWay])-4)=self.ValueListEditorVResult.Cells[ACol,ARow] then
  begin
    self.ValueListEditorVResult.Canvas.Brush.Color:=TColor($FFeeee);
    self.ValueListEditorVResult.Canvas.Font.Color:=clRed;
    self.ValueListEditorVResult.Canvas.TextRect(Rect,0,0,'');
    self.ValueListEditorVResult.Canvas.TextOut(Rect.Left+3,Rect.Top+3, self.RxCheckListBox2.Items.Strings[FBWay]);
  end
  else
  begin
  //
  end;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
  try
    if Application.FindComponent('frmPropertiesSet')=nil then
       Application.CreateForm(TfrmPropertiesSet, frmPropertiesSet);
    frmPropertiesSet.ShowModal;
  except
  end;
end;

procedure TfrmMain.BitBtn6Click(Sender: TObject);
var
  i    :integer;
  sKey :string;
begin
  try
    //
    for i:=1 to self.ValueListEditorPResult.RowCount-1 do
    begin
      sKey:=self.ValueListEditorPResult.Cells[0,i];
      ClientDataSetPType.First;
      while not(ClientDataSetPType.eof) do
      begin
         if sKey=ClientDataSetPType.fieldByName('F_TP_NAME').AsString then
         begin
           ClientDataSetPType.Edit;
           ClientDataSetPType.FieldByName('F_TP_DEFAULT').AsFloat:=strtofloat(self.ValueListEditorPResult.Cells[1,i]);
           ClientDataSetPType.Last;
         end;
         ClientDataSetPType.Next;
      end;
      ClientDataSetPTypeopenTemp.Next;
    end;
    //
  except
    //
  end;
end;

procedure TfrmMain.N17Click(Sender: TObject);
var
    MyFormat    : Word;
    AData       : THandle;
    APalette    : HPALETTE;
begin
    Clipboard.Clear;
    self.ImageMain.Picture.Bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette);
    ClipBoard.SetAsHandle(MyFormat,AData);
end;

procedure TfrmMain.C1Click(Sender: TObject);
begin
    self.ValueListEditorSaveTemp.Strings.Text:=
             self.ValueListEditorPResult.Strings.Text
            +self.ValueListEditorVResult.Strings.Text;
    Clipboard.Clear;
    Clipboard.AsText:=self.ValueListEditorSaveTemp.Strings.Text;
    self.ValueListEditorSaveTemp.Strings.Text:='';
end;

procedure TfrmMain.MenuItem1Click(Sender: TObject);
var
    MyFormat    : Word;
    AData       : THandle;
    APalette    : HPALETTE;
begin
    Clipboard.Clear;
    self.ImageXY.Picture.Bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette);
    ClipBoard.SetAsHandle(MyFormat,AData);
end;

procedure TfrmMain.EditDataxcKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
  begin
    BitBtn2Click(Sender);
  end;
end;

procedure TfrmMain.ComboBoxFunctionKeyPress(Sender: TObject;
  var Key: Char);
begin
  if key=#13 then
  begin
    BitBtn1Click(Sender);
  end;
end;

procedure TfrmMain.ListBoxhistoryDblClick(Sender: TObject);
var
  str   :string;
begin
  try
    if self.ListBoxhistory.ItemIndex<0 then exit;
    str:=self.ListBoxhistory.Items.Strings[self.ListBoxhistory.ItemIndex];
    if str[3]='=' then
    begin
      self.ComboBox4.ItemIndex:=strtoint(copy(str,2,1));
      self.EditData.Text:=copy(str,4,length(str)-3);
    end
    else
    begin
      self.ComboBox4.ItemIndex:=strtoint(copy(str,2,2));
      self.EditData.Text:=copy(str,5,length(str)-4);
    end;
    self.ListBoxhistory.Visible:=false;
  except
  end;
end;

procedure TfrmMain.Panel11Exit(Sender: TObject);
begin
  self.ListBoxhistory.Visible:=false;
end;

procedure TfrmMain.ActionCompileExecute(Sender: TObject);
begin
  BitBtn1Click(Sender);
end;

procedure TfrmMain.ActionHelp1Execute(Sender: TObject);
begin
  try
     RunExe('帮助\'+'多元非线性回归分析 函数模型的表达式说明.htm');
  except
  end;
end;

procedure TfrmMain.ActionHelpMainExecute(Sender: TObject);
begin
  try
     RunExe('帮助\'+'多元非线性回归分析 帮助主题.htm');
  except
  end;
end;

procedure TfrmMain.ImageXYMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  pxMin:integer;
  pxMax:integer;
  pyMin:integer;
  pyMax:integer;
  Cx,Cy:Extended;
begin
  try
    pxMin:=self.ImageXY.Width div 10;
    pxMax:=self.ImageXY.Width*9 div 10;
    pyMin:=self.ImageXY.Height*9 div 10;
    pyMax:=self.ImageXY.Height div 10;

   // if () or () then
    begin
      Cx:=(X-pxMin)/(pxMax-PxMin)*(PicxMax-PicxMin)+PicxMin;
      Cy:=(Y-pyMin)/(pyMax-PyMin)*(PicyMax-PicyMin)+PicyMin;
    end;

    self.StatusBarData.Panels[3].Text:='X:'+floattostr(Cx)+' '+'Y:'+floattostr(Cy);
    //self.LabelX.Caption:='X:'+floattostr(Cx);
    //self.LabelY.Caption:='Y:'+floattostr(Cy);
  except
    self.StatusBarData.Panels[3].Text:='';
    //self.LabelX.Caption:='';
    //self.LabelY.Caption:='';
  end;
end;

procedure TfrmMain.ImageMainMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Cx,Cy:Extended;
begin
  try
    cx:=0;
    cy:=0;
    if (ppxMax-PpxMin<>0) and (ppyMax-PpyMin<>0) then
    begin
      Cx:=(X-ppxMin)/(ppxMax-PpxMin)*(PxxMax-PxxMin)+PxxMin;
      Cy:=(Y-ppyMin)/(ppyMax-PpyMin)*(PyyMax-PyyMin)+PyyMin;
    end;
                                               
    self.LabelXx.Caption:='X:'+floattostr(Cx);
    self.LabelYy.Caption:='Y:'+floattostr(Cy);
  except
    self.LabelXx.Caption:='';
    self.LabelYy.Caption:='';
  end;
end;

procedure TfrmMain.ClientDataSetDataAfterPost(DataSet: TDataSet);
begin
  try
    self.StatusBarData.Panels[0].Text:=' 记录数：'+inttostr(ClientDataSetDataOld.RecordCount);
    self.StatusBarData.Panels[1].Text:=' 选中记录序号：'+inttostr(ClientDataSetDataOld.RecNo);
  except
  end;
end;

procedure TfrmMain.ClientDataSetDataAfterScroll(DataSet: TDataSet);
begin
  try
    self.StatusBarData.Panels[1].Text:=' 选中记录序号：'+inttostr(ClientDataSetDataOld.RecNo);
  except
  end;
end;

procedure TfrmMain.DBGridDataOldTitleClick(Column: TColumn);
begin
  try
    ClientDataSetDataOld.IndexFieldNames:=Column.FieldName;
  except
  end;
end;

procedure TfrmMain.ClientDataSetDataAfterDelete(DataSet: TDataSet);
begin
  try
    self.StatusBarData.Panels[0].Text:=' 记录数：'+inttostr(ClientDataSetDataOld.RecordCount);
    self.StatusBarData.Panels[1].Text:=' 选中记录序号：'+inttostr(ClientDataSetDataOld.RecNo);
  except
  end;
end;

procedure TfrmMain.ClientDataSetDataAfterClose(DataSet: TDataSet);
begin
  try
    self.StatusBarData.Panels[0].Text:=' 没有打开数据 ';
    self.StatusBarData.Panels[1].Text:='';
  except
  end;
end;

procedure TfrmMain.TabDataIndexChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  try
    ClientDataSetDataOld:=ClientDataSetData[NewTab];
    DataSourceDataOld.DataSet:=nil;
    DataSourceDataOld.DataSet:=ClientDataSetDataOld;
    self.StatusBarData.Panels[0].Text:=' 记录数：'+inttostr(ClientDataSetDataOld.RecordCount);
    self.StatusBarData.Panels[1].Text:=' 选中记录序号：'+inttostr(ClientDataSetDataOld.RecNo);
  except
  end;
end;

procedure TfrmMain.SpinButtonChangeFunctionIndexDownClick(Sender: TObject);
begin
  try
    ListBoxhistoryDblClick(Sender);
    self.ListBoxhistory.ItemIndex:= self.ListBoxhistory.ItemIndex+1;
  except
  end;
end;

procedure TfrmMain.SpinButtonChangeFunctionIndexUpClick(Sender: TObject);
begin
  try
    ListBoxhistoryDblClick(Sender);
    self.ListBoxhistory.ItemIndex:= self.ListBoxhistory.ItemIndex-1;
    if self.ListBoxhistory.ItemIndex=-1 then self.ListBoxhistory.ItemIndex:=0;
  except
  end;
end;

procedure TfrmMain.ImageLookSoomClick(Sender: TObject);
begin
  try
    if Application.FindComponent('frmLook')=nil then
       Application.CreateForm(TfrmLook, frmLook);
    frmLook.ShowModal;
  except
  end;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
var
  strTemp  :string;
begin
  try
    strTemp:='';
    if Application.FindComponent('frmEditFunction')=nil then
       Application.CreateForm(TfrmEditFunction, frmEditFunction);
    frmEditFunction.MemoEdit.Text:=self.ComboBoxFunction.Text;
    frmEditFunction.Pstr:=@strTemp;
    frmEditFunction.ShowModal;
    if strTemp<>'' then
    begin
      self.ComboBoxFunction.Text:=frmEditFunction.MemoEdit.Text;
    end;
  except
  end;
end;

procedure TfrmMain.Button5Click(Sender: TObject);
var
  strTemp  :string;
begin
  try
    strTemp:='';
    if Application.FindComponent('frmEditFunction
上一页 1 2 3 45
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -