曲线拟合源代码_第1页
曲线拟合源代码_第2页
曲线拟合源代码_第3页
曲线拟合源代码_第4页
曲线拟合源代码_第5页
全文预览已结束

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

OptionExplicitDimX()AsSingle,Y()AsSingleDimA(20,20)AsSingle,MAsInteger,B()AsSingle'最多取20次的拟合DimNAsInteger,IAsInteger,JAsIntegerDimxiaoA()AsSingleDimXminAsSingle,XmaxAsSingleDimYminAsSingle,YmaxAsSingleDimXoAsSingle,YoAsSinglePrivateSubZuoDian(X()AsSingle,Y()AsSingle)DimXLAsSingleDimYLAsSingleN=UBound(X):Picture1.Cls '确定数组的指定维的最大可用下标Xmin=X(1):Xmax=X(1):Xo=X(1):Yo=Y(1)Ymin=Y(1):Ymax=Y(1)ForI=1ToNIfXmin>X(I)Then '(实现比较问题)Xmin=X(I)Xo=Xmin:Yo=Y(I) '后面画曲线时用到EndIfIfXmax<X(I)ThenXmax=X(I)IfYmin>Y(I)ThenYmin=Y(I)IfYmax<Y(I)ThenYmax=Y(I)NextIXL=Xmax-Xmin:YL=Ymax-YminPicture1.Scale(Xmin-XL/10,Ymax+YL/10)-(Xmax+XL/10,Ymin-YL/10)Picture1.DrawWidth=5ForI=1ToNPicture1.PSet(X(I),Y(I)),vbRed'(将对象上的点设为指定颜色)NextIPicture1.DrawWidth=1Picture1.Line(Xmin,Ymin)-(Xmax,Ymax),vbBlue,BPicture1.RefreshEndSubPrivateSubHuaQuXian(xiaoA()AsSingle)CallZuoDian(X,Y)DimYsumAsSingle,IiAsSingleForIi=XminToXmaxStep(Xmax-Xmin)/100Ysum=0ForJ=1ToMYsum=Ysum+xiaoA(J)*IiA(J-1)NextJPicturel.Line(Xo,Yo)-(Ii,Ysum)Xo=Ii:Yo=YsumNextIiEndSubPrivateSubCommand1_Click()DimFileNameAsStringDimXstrAsString,YstrAsStringOnErrorGoToerrhandleCommonDialog1.InitDir=App.Path设置初始路径 数据导入CommonDialog1.FileName=""清除文件名CommonDialog1.ShowOpen显示“打开”对话框FileName=CommonDialog1.FileName保存文件名IfLen(CommonDialog1.FileName)>0Then'File=FreeFile()'获得可用文件号OpenFileNameForInputAs#1打开文件EndIfI=0MousePointer=11DoWhileEOF(1)=FalseI=I+1ReDimPreserveX(I)ReDimPreserveY(I)MSFlexGrid1.Rows=I+1Input#1,Xstr,Ystr'分别输入各数据MSFlexGrid1.TextMatrix(I,1)=XstrX(I)=Val(Xstr)MSFlexGrid1.TextMatrix(I,2)=YstrY(I)=Val(Ystr)MSFlexGrid1.TextMatrix(I,0)=ILoopClose#1:N=I '检验一下N是否对???CallZuoDian(X,Y)errhandle:MousePointer=0ExitSubMousePointer=0EndSubPrivateSubCommand2_Click()'曲线拟合DimXhAsIntegerM=Val(Combo1.Text)+1EraseB:ErasexiaoA:EraseA '必不可少***********重新初始化大小固定的数组的元素,以及释放动态数组的存储空间ReDimB(M):ReDimxiaoA(1ToM)'形成方程组的各元素A(1,1)=NForI=1ToNB(1)=B(1)+Y(I)NextIForJ=2ToMForI=1ToNA(1,J)=A(1,J)+X(I)人(J-1)NextINextJForI=2ToMForJ=1ToMForXh=1ToNA(I,J)=A(I,J)+X(Xh)A(I+J-2)IfJ=1ThenB(I)=B(I)+X(Xh)a(I-1)*Y(Xh)EndIfNextXhNextJNextICallJieFangCheng(A,B,xiaoA)ForI=1ToMText1.Text=Text1.Text&"a"&I-1&"="&xiaoA(I)&";"NextIDimStrAsString:Str="y="ForI=1ToM '写方程IfI<MThenStr=Str&xiaoA(I)&"xA"&I-1&"+"ElseStr=Str&xiaoA(I)&"xA"&I-1EndIfNextITextl.Text=Textl.Text&vbCrLf&曲线方程:"&vbCrLf&StrCallHuaQuXian(xiaoA)EndSubPrivateSubCommand3_Click()DimXzhiAsSingle,YzhiAsSingleXzhi=Val(Text2.Text)Yzhi=0ForJ=1ToMYzhi=Yzhi+xiaoA(J)*XzhiA(J-1)NextJText3.Text=YzhiEndSubPrivateSubForm_Load()ForI=0To2MSFlexGridl.ColAlignment(I)=4NextIForI=1To20MSFlexGrid1.TextMatrix(I,0)=INextIEndSubPrivateSubJieFangCheng(A()AsSingle,B()AsSingle,X()AsSingle)N=UBound(B)DimTempAAsSingle,LAsInteger,KAsInteger,KkAsIntegerDimIiAsInteger,ChuShuAsSingle,SumAsSingleForI=1ToNL=0:Kk=0ForJ=IToNIfA(J,I)=0ThenL=L+1NextJForJ=IToN-LIfA(J,I)=0ThenKk=Kk+1ForK=IToNTempA=A(J,K)A(J,K)=A(N-Kk+1,K)A(N-Kk+1,K)=TempANextKTempA=B(J):B(J)=B(N-Kk+1):B(N-Kk+1)=TempAEndIfNextJForIi=IToN-LChuShu=A(Ii,I)ForJ=IToNA(Ii,J)=A(Ii,J)/ChuShuNextJB(Ii)=B(Ii)/ChuShuNextIiForIi=I+1ToN-LForJ=IToNA(Ii,J)=A(Ii,J)-A(I,J)NextJB(Ii)=B(Ii)-B(I)NextIiNextIFor

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

评论

0/150

提交评论