📄 rs3calccfg.pas

📁 最小二乘相关介绍,最小二乘相关介绍,及其原程序!仔细整理收获不少!
💻 PAS
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
    Application.MessageBox('文件在保存过程中出现错误！','错误',MB_OK+MB_ICONERROR);
end;

{ 显示帮助信息 }
procedure TRS3CalcForm.actHelpTopicExecute(Sender: TObject);
begin
	FHTMLhelpRouter.HelpContent;
end;

{ 显示“关于”对话框 }
procedure TRS3CalcForm.actHelpAboutExecute(Sender: TObject);
begin
{
	with TRS3AboutForm.Create(Self) do
  try
    FlatListBoxModule.Items.Clear;
    FlatListBoxModule.Items.Add('模块名称：“传感器输入-输出特性校准”');
    FlatListBoxModule.Items.Add('实现功能：采用最小二乘法计算压力、温度和流量传感器测量系统的拟合方程。');
    FlatListBoxModule.Items.Add('模块版本：V1.01');
    FlatListBoxModule.Items.Add('设计单位：研发中心');
    FlatListBoxModule.Items.Add('公司：航天科技集团公司达宇特种车辆制造厂');
    FlatListBoxModule.Items.Add('适用产品：RS-3 供油机构高低温、高空性能试验测量控制系统');
    FlatListBoxModule.Items.Add('产品版本：V1.00');
    FlatListBoxModule.Items.Add('版权所有 (C) 2002-2004 航天科技集团公司四川达宇特种车辆制造厂。');
    ShowModal;
  finally
    Free;
  end;
}
end;

{ 修改单元格字体和背景颜色 }
procedure TRS3CalcForm.RS3StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  A1,A2,W,H: integer;
  str: string;
begin
	// 获取单元格内容及其宽度和高度
	Str := RS3StringGrid.Cells[Acol,Arow];
  W := RS3StringGrid.Canvas.textwidth(Str);
  H := RS3StringGrid.Canvas.textheight(Str);
  // 居中对齐
  A1 := (RS3StringGrid.Colwidths[ACol] - W) div 2;
  A2 := (RS3StringGrid.Rowheights[ARow] - H) div 2;
  // 设置单元格颜色
  if gdFixed in state then
		RS3StringGrid.Canvas.Brush.Color := clBtnFace
  else if gdSelected in state then
  	RS3StringGrid.Canvas.Brush.Color := clCream//clSilver
  else
  	RS3StringGrid.Canvas.Brush.Color := ClWhite;      //clCream;
  // 设置单元格字体颜色
  case cboxItemName.ItemIndex of
    0,1,2:
    	begin
        if (ACol = 3) or (ACol = 4) then
      		RS3StringGrid.Canvas.Font.Color := clMaroon
    		else
      		RS3StringGrid.Canvas.Font.Color := clGreen;
      end;
    3:
    	begin
        if ACol = 2 then
      		RS3StringGrid.Canvas.Font.Color := clMaroon
    		else
      		RS3StringGrid.Canvas.Font.Color := clGreen;
      end;
    4,5:
      begin
        if (ACol = 1) or (ACol = 3) then
      		RS3StringGrid.Canvas.Font.Color := clMaroon
    		else
      		RS3StringGrid.Canvas.Font.Color := clGreen;
      end;
  end;
  // 以居中方式绘制单元格内容
  RS3StringGrid.Canvas.TextRect(Rect,Rect.left+A1,Rect.Top+A2,RS3StringGrid.Cells[ACol,ARow]);
end;

{ 禁止“拟合值”列内容被用户更改 }
procedure TRS3CalcForm.RS3StringGridSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  // 对某些列（如“拟合输出值”列）禁止用户修改
  case cboxItemName.ItemIndex of
    0,1,2:
    	begin
        if (ACol = 3) or (ACol = 4) then
      		RS3StringGrid.Options := RS3StringGrid.Options - [goEditing]
    		else
      		RS3StringGrid.Options := RS3StringGrid.Options + [goEditing];
      end;
    3:
    	begin
        if ACol = 2 then
	  			RS3StringGrid.Options := RS3StringGrid.Options - [goEditing]
  			else
    			RS3StringGrid.Options := RS3StringGrid.Options + [goEditing];
      end;
    4,5:
    	begin
        if (ACol = 1) or (ACol = 3) then
      		RS3StringGrid.Options := RS3StringGrid.Options - [goEditing]
    		else
      		RS3StringGrid.Options := RS3StringGrid.Options + [goEditing];
      end;
  end;
end;

{ 如果用户更改了数据，则允许保存 }
procedure TRS3CalcForm.actSaveUpdate(Sender: TObject);
begin
  actSave.Enabled := FCalcCoef[cboxItemName.ItemIndex].bModified;
end;

procedure TRS3CalcForm.RS3StringGridMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  RS3StringGrid.MouseToCell(X,Y,FACol,FARow);
end;

function  TRS3CalcForm.SaveDataToFile(Index: Integer): Boolean;
var
  strLine,strTemp: String;
  i: Integer;
  pFile: TFileStream;

  procedure WriteCoef(Index: Integer);
  var
    i: Integer;
  begin
    if FCalcCoef[Index].nPower = 1 then
	    strLine := '拟合次数：' + IntToStr(FCalcCoef[Index].nPower) + '次（线性方程）' + #13
    else
    	strLine := '拟合次数：' + IntToStr(FCalcCoef[Index].nPower) + '次' + #13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    for i := 0 to FCalcCoef[Index].nPower do
    begin
      strTemp := '系数项(A' + IntToStr(i) + ')：';
      strLine := strTemp + FormatFloat('0.0000000E+00',FCalcCoef[Index].fCoef[i]) + #13;
      pFile.Write(PChar(strLine)^,Length(strLine));
    end;
    strLine := '均方根误差：' + FormatFloat('0.0000000E+00',FCalcCoef[Index].fError) + '(' + FCalcCoef[Index].sUnitOut + ')' + #13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    strLine := '最新拟合时间：' + FCalcCoef[Index].szCalcTime + #13;
    pFile.Write(PChar(strLine)^,Length(strLine));
  end;

begin
	Result := false;
  FstrFileName := ExtractFileDir(Application.ExeName) + '\Report';
  if not DirectoryExists(FstrFileName) then CreateDir(FstrFileName);
  FstrFileName := FstrFileName + '\Calibration';
  if not DirectoryExists(FstrFileName) then CreateDir(FstrFileName);
  FstrFileName := FstrFileName + '\C_' + cboxItemName.Items.Strings[Index] + '.cal';
  if FileExists(FstrFileName) then
  begin
    if Application.MessageBox(PChar('文件“'+FstrFileName+'”已经存在，是否要将现有文件替换为新的同名文件？'),'保存提示',MB_YESNO+MB_ICONINFORMATION) = IDYES then
    begin
      DeleteFile(FstrFileName);
      pFile := TFileStream.Create(FstrFileName,fmCreate);
    end else
      pFile := TFileStream.Create(FstrFileName,fmOpenReadWrite);
  end else
    pFile := TFileStream.Create(FstrFileName,fmCreate);
  try
  	// 写文件头
    strLine := '最小二乘法曲线拟合'+#13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    strLine := Format('%s',[DateTimeToStr(Now)])+#13+#13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    strLine := cboxItemName.Items.Strings[Index] + #13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    strLine := DupeString('-',120)+#13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    // 写拟合原始数据（含拟合后的数据）
    strLine := Format('%-20s%-20s%-20s%-20s',['测量输入(' + FCalcCoef[Index].sUnitIn + ')',
                                              '测量输出(' + FCalcCoef[Index].sUnitOut + ')',
                                              '拟合输出(' + FCalcCoef[Index].sUnitOut + ')',
                                              '相对误差(%)']) + #13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    for i := 0 to FCalcCoef[Index].nDataNums-1 do
    begin
    	if Length(Trim(RS3StringGrid.Rows[i].Text)) = 0 then Break;
      strLine := Format('%-20s%-20s%-20s%-20s',[FormatFloat('0.0000000',FCalcData[Index,i].fDataOut),
                                                FormatFloat('0.0000000',FCalcData[Index,i].fDataIn),
                                                FormatFloat('0.0000000',FCalcData[Index,i].fCalcOut),
                                                FormatFloat('0.0000000',FCalcData[Index,i].fPerError)]) + #13;
      pFile.Write(PChar(strLine)^,Length(strLine));
    end;
    // 写拟合方程的系数
    strLine := DupeString('-',40)+#13;
    pFile.Write(PChar(strLine)^,Length(strLine));
    WriteCoef(Index);
    strLine := DupeString('-',120);
    pFile.Write(PChar(strLine)^,Length(strLine));
    Result := true;
  finally
    pFile.Free;
  end;
end;

procedure TRS3CalcForm.EditPowerKeyPress(Sender: TObject; var Key: Char);
begin
	// 只允许数字和Home,End,Left,Right,Delete,BackSpace输入
  if not (Key in ['0'..'9',Char(VK_HOME),Char(VK_END),Char(VK_LEFT),Char(VK_RIGHT),Char(VK_DELETE),Char(VK_BACK)]) then
  	Key := #0;
  {
  // 不能以0打头
  if (Length(EditPower.Text) > 0) and (Key = '0') then
  	Key := '1';
  }
end;

{ 检查输入的数字是否越界 }
procedure TRS3CalcForm.EditPowerChange(Sender: TObject);
var
	i,nPower: Integer;
  bHasZero: Boolean;
begin
  try
  	if EditPower.Text = '' then
    	EditPower.Text := '1'
    else
    begin
    	i := 1;
      bHasZero := false;
    	while EditPower.Text[i] = '0' do
      begin
        bHasZero := true;
      	Inc(i);
      end;
      Dec(i);
      if bHasZero then
      begin
        if Length(EditPower.Text) > i then
		      EditPower.Text := Copy(EditPower.Text,i+1,Length(EditPower.Text)-i)
        else
          EditPower.Text := '1';
      end;
	  	nPower := StrToInt(EditPower.Text);
  	  if nPower < 1 then EditPower.Text := '1';
    	if nPower > 20 then EditPower.Text := '20';
    end;
  except
    Application.MessageBox('请输入1～20之间的任意整数！','提示',MB_OK+MB_ICONINFORMATION);
  end;
end;

{ 删除数据记录 }
procedure TRS3CalcForm.actItemDeleteExecute(Sender: TObject);
begin
	if Application.MessageBox('本操作会删除项目的所有数据（不可恢复），继续？','警告',MB_YESNO+MB_ICONWARNING) = IDNO then
		Exit;

end;

{ 添加数据记录 }
procedure TRS3CalcForm.actItemAddExecute(Sender: TObject);
var
	i,nLen: Integer;
begin
	nLen := Length(Trim(EditItem.Text));
	if (nLen > 0) and (nLen < 100) then
  begin
  	for i := 0 to cboxItemName.Items.Count-1 do
    begin
    	if EditItem.Text = cboxItemName.Items.Strings[i] then
      begin
        Application.MessageBox(PChar('项目：' + EditItem.Text + '已经存在！'), '警告',MB_OK+MB_ICONWARNING);
      	Exit;
      end;
    end;
    cboxItemName.Items.Add(EditItem.Text);
    FCalcCoef[cboxItemName.Items.Count-1].sItemName := EditItem.Text;
    cboxItemName.ItemIndex := cboxItemName.Items.Count-1;
    with DAOTable1 do
    begin
			if not Active then Open;
      Append;
      FieldByName('ItemName').AsString := EditItem.Text;
      FieldByName('UnitIn').AsString := EditUnitIn.Text;
      FieldByName('UnitOut').AsString := EditUnitOut.Text;
      FieldByName('CalcTime').AsDateTime := Now;
      Post;
    end;
     with DAOTable2 do
    begin
			if not Active then Open;
      Append;
      FieldByName('ItemName').AsString := EditItem.Text;
      Post;
    end;
  end else
  	Application.MessageBox('请输入正确的项目名称！','警告',MB_OK+MB_ICONWARNING);
end;

procedure TRS3CalcForm.actItemDeleteUpdate(Sender: TObject);
begin
	actItemDelete.Enabled := cboxItemName.Items.Count > 0;
end;

procedure TRS3CalcForm.actItemAddUpdate(Sender: TObject);
begin
	actItemAdd.Enabled := Length(Trim(EditItem.Text)) > 0;
end;

end.
上一页 1 23
💿 文件大小 535 K
👤 上传用户 gxjun686
📂 所属分类数学计算
🏷️ 相关标签

#程序
⌨️ 快捷键说明

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