📄 n次多项式拟合.frm
字号:
VERSION 5.00
Object = "{D76D7130-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSFLEX7D.OCX"
Begin VB.Form frmdcnh
BorderStyle = 3 'Fixed Dialog
Caption = "n次多项式拟合"
ClientHeight = 4020
ClientLeft = 45
ClientTop = 345
ClientWidth = 6210
Icon = "n次多项式拟合.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4020
ScaleWidth = 6210
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Caption = "计算结果"
Height = 2895
Left = 2640
TabIndex = 8
Top = 640
Width = 3495
Begin VB.ListBox List1
Height = 2580
Left = 120
TabIndex = 9
Top = 240
Width = 3255
End
End
Begin VSFlex7DAOCtl.VSFlexGrid VSFlexGrid1
Height = 3255
Left = 0
TabIndex = 2
Top = 720
Width = 2535
_cx = 4471
_cy = 5741
_ConvInfo = 1
Appearance = 1
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = 14737632
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 3
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 3
SelectionMode = 0
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 2
Cols = 3
FixedRows = 1
FixedCols = 1
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 2
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 3
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
End
Begin VB.Frame Frame1
Caption = "原始数据"
Height = 615
Left = 0
TabIndex = 5
Top = 0
Width = 6135
Begin VB.TextBox Text2
Height = 270
Left = 5040
TabIndex = 1
Text = "Text2"
Top = 240
Width = 975
End
Begin VB.TextBox Text1
Height = 270
Left = 1440
TabIndex = 0
Text = "Text1"
Top = 240
Width = 975
End
Begin VB.Label Label2
Caption = "拟合曲线最高次幂n＝"
Height = 255
Left = 3240
TabIndex = 7
Top = 285
Width = 1815
End
Begin VB.Label Label1
Caption = "实验数据数目M＝"
Height = 255
Left = 120
TabIndex = 6
Top = 280
Width = 1575
End
End
Begin VB.CommandButton Command2
Caption = "关闭"
Height = 375
Left = 5280
TabIndex = 4
Top = 3600
Width = 855
End
Begin VB.CommandButton Command1
Caption = "计算"
Height = 375
Left = 4200
TabIndex = 3
Top = 3600
Width = 855
End
End
Attribute VB_Name = "frmdcnh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dn, n As Integer
Dim d(), b(), a() As Double
Private Sub Command1_Click()
'计算
On Error GoTo handlerror
dn = Val(Text1.Text)
n = Val(Text2.Text)
ReDim d(dn, 1), b(n), a(n + 1, n + 2)
ym = -90000000000#
yn = 90000000000#
For i = 1 To VSFlexGrid1.Rows - 1
d(i, 1) = Val(VSFlexGrid1.TextMatrix(i, 1))
d(i, 0) = Val(VSFlexGrid1.TextMatrix(i, 2))
If ym < d(i, 0) Then ym = d(i, 0): xm = d(i, 1)
If yn > d(i, 0) Then yn = d(i, 0): xn = d(i, 1)
Next i
Call jisuan
List1.Clear
List1.AddItem "拟合曲线为：" + Str(n - 1) + "次多项式，各项系数为："
For i = 1 To n
b(i - 1) = a(i, n + 1)
List1.AddItem "A" + Trim$(Str(i - 1)) + "＝" + Str(Int(b(i - 1) * 10000 + 0.5) / 10000)
Next i
dx = d(dn, 1) - d(1, 1)
dy = ym - yn
x = d(1, 1)
y2 = yn
Do Until x > 1.01 * dx + d(1, 1)
x1 = x
y = b(0) + b(1) * x
For i = 2 To n - 1
x1 = x1 * x
y = y + x1 * b(i)
Next i
If y2 > y Then y2 = y: xn = x
If ym < y Then ym = y: xm = x
x = x + 1.1 * dx / 100
Loop
List1.AddItem ""
List1.AddItem "拟合曲线段内Ymax＝" + Str(Int(ym * 1000 + 0.5) / 1000)
List1.AddItem "对应的 Xman＝" + Str(Int(xm * 1000 + 0.5) / 1000)
List1.AddItem "Y的极小值 Ymin＝" + Str(Int(y2 * 1000 + 0.5) / 1000)
List1.AddItem "对应的 Xmin＝" + Str(Int(xn * 1000 + 0.5) / 1000)
Exit Sub
handlerror:
xianshi = MsgBox("请检查输入的数据后再计算。", vbInformation, "问题提示")
End Sub
Private Sub Command2_Click()
'关闭
On Error GoTo handlerror
If List1.ListCount > 1 And rjsfzc = 88 Then
frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 《n次多次项拟合计算结果》："
For i = 0 To List1.ListCount - 1
frmMain.Text1 = frmMain.Text1 & vbCrLf & " " + List1.List(i)
Next i
frmMain.Text1 = frmMain.Text1 & vbCrLf & " --------------------------------------"
End If
Unload Me
Exit Sub
handlerror:
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
On Error GoTo handlerror
If KeyAscii = 27 Then
Unload Me
End If
Exit Sub
handlerror:
End Sub
Private Sub Form_Load()
'启动
Text1.Text = ""
Text2.Text = ""
List1.Clear
VSFlexGrid1.TextMatrix(0, 0) = "序号"
VSFlexGrid1.TextMatrix(0, 1) = "数据Xi"
VSFlexGrid1.TextMatrix(0, 2) = "数据Yi"
VSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter
VSFlexGrid1.ColAlignment(1) = flexAlignCenterCenter
VSFlexGrid1.ColAlignment(2) = flexAlignCenterCenter
VSFlexGrid1.ColWidth(0) = 460
VSFlexGrid1.ColWidth(1) = 870
VSFlexGrid1.ColWidth(2) = 870
End Sub
Private Sub Text1_Change()
'实验数据数目
On Error GoTo handlerror
If Val(Text1.Text) >= 2 Then
VSFlexGrid1.Rows = Val(Text1.Text) + 1
For i = 1 To VSFlexGrid1.Rows - 1
VSFlexGrid1.TextMatrix(i, 0) = i
Next i
End If
Exit Sub
handlerror:
End Sub
Public Sub jisuan()
'计算子程序
n = n + 1
a(1, 1) = dn
For j = 2 To n
a(1, j) = 0
a(j, n) = 0
For i = 1 To dn
a(1, j) = a(1, j) + d(i, 1) ^ (j - 1)
a(j, n) = a(j, n) + d(i, 1) ^ (n + j - 2)
Next i
Next j
a(1, n + 1) = 0
For j = 1 To dn
a(1, n + 1) = a(1, n + 1) + d(j, 0)
Next j
For i = 2 To n
a(i, n + 1) = 0
For j = 1 To dn
a(i, n + 1) = a(i, n + 1) + d(j, 0) * d(j, 1) ^ (i - 1)
Next j
Next i
For i = 2 To n
For j = 1 To i - 1
a(j + 1, i - j) = a(1, i)
a(n + 1 - i + j, n - j) = a(n + 1 - i, n)
Next j
Next i
For i = 1 To n
If i = n Then GoTo 10
am = Abs(a(i, i))
im = i
For j = i + 1 To n
aa = Abs(a(j, i))
If am < aa Then am = aa: im = j
Next j
If i = im Then GoTo 10
For j = 1 To n + 1
aa = a(i, j)
a(i, j) = a(im, j)
a(im, j) = aa
Next j
10: p = a(i, i)
For j = i + 1 To n + 1
a(i, j) = a(i, j) / p
Next j
For j = 1 To n
If a(j, i) = 0 Or j = i Then GoTo 20
p = a(j, i)
For k = i + 1 To n + 1
a(j, k) = a(j, k) - p * a(i, k)
Next k
20: Next j
Next i
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -