📄 form1.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
Caption = "曲线拟合"
ClientHeight = 9330
ClientLeft = 60
ClientTop = 345
ClientWidth = 10590
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 9330
ScaleWidth = 10590
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "曲线拟合"
Height = 615
Left = 720
TabIndex = 12
Top = 8280
Width = 2175
End
Begin VB.TextBox Text1
Height = 975
Left = 4200
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 11
Top = 8160
Width = 6015
End
Begin VB.CommandButton Command1
Caption = "打开点文件"
Height = 495
Left = 1080
TabIndex = 9
Top = 840
Width = 1695
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
Height = 6000
Left = 4200
ScaleHeight = 5940
ScaleWidth = 5940
TabIndex = 7
Top = 360
Width = 6000
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form1.frx":030A
Left = 2040
List = "Form1.frx":032F
TabIndex = 6
Text = "6"
Top = 7320
Width = 615
End
Begin VB.Frame Frame1
Caption = "插值计算"
Height = 1215
Left = 5040
TabIndex = 0
Top = 6600
Width = 4335
Begin VB.TextBox Text2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 3
Top = 480
Width = 735
End
Begin VB.CommandButton Command3
Height = 345
Left = 1920
MaskColor = &H00FFFFFF&
Picture = "Form1.frx":0356
Style = 1 'Graphical
TabIndex = 2
Top = 480
UseMaskColor = -1 'True
Width = 340
End
Begin VB.TextBox Text3
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3120
TabIndex = 1
Top = 480
Width = 735
End
Begin VB.Label Label2
Caption = "X="
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 5
Top = 550
Width = 1215
End
Begin VB.Label Label3
Caption = "Y="
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2760
TabIndex = 4
Top = 550
Width = 255
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3120
Top = 1080
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 4695
Left = 480
TabIndex = 8
Top = 1680
Width = 2775
_ExtentX = 4895
_ExtentY = 8281
_Version = 393216
Rows = 21
Cols = 3
FormatString = "^记录数|^ X|^ Y"
End
Begin VB.Label Label1
Caption = "拟合次数"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 10
Top = 7320
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim X() As Single, Y() As Single
Dim A(20, 20) As Single, M As Integer, B() As Single '最多取20次的拟合
Dim N As Integer, I As Integer, J As Integer
Dim xiaoA() As Single
Dim Xmin As Single, Xmax As Single
Dim Ymin As Single, Ymax As Single
Dim Xo As Single, Yo As Single
Private Sub ZuoDian(X() As Single, Y() As Single)
Dim XL As Single
Dim YL As Single
N = UBound(X): Picture1.Cls
Xmin = X(1): Xmax = X(1): Xo = X(1): Yo = Y(1)
Ymin = Y(1): Ymax = Y(1)
For I = 1 To N
If Xmin > X(I) Then
Xmin = X(I)
Xo = Xmin: Yo = Y(I) '后面画曲线时用到。
End If
If Xmax < X(I) Then Xmax = X(I)
If Ymin > Y(I) Then Ymin = Y(I)
If Ymax < Y(I) Then Ymax = Y(I)
Next I
XL = Xmax - Xmin: YL = Ymax - Ymin
Picture1.Scale (Xmin - XL / 10, Ymax + YL / 10)-(Xmax + XL / 10, Ymin - YL / 10)
Picture1.DrawWidth = 5
For I = 1 To N
Picture1.PSet (X(I), Y(I)), vbRed
Next I
Picture1.DrawWidth = 1
Picture1.Line (Xmin, Ymin)-(Xmax, Ymax), vbBlue, B
Picture1.Refresh
End Sub
Private Sub HuaQuXian(xiaoA() As Single)
Call ZuoDian(X, Y)
Dim Ysum As Single, Ii As Single
For Ii = Xmin To Xmax Step (Xmax - Xmin) / 100
Ysum = 0
For J = 1 To M
Ysum = Ysum + xiaoA(J) * Ii ^ (J - 1)
Next J
Picture1.Line (Xo, Yo)-(Ii, Ysum)
Xo = Ii: Yo = Ysum
Next Ii
End Sub
Private Sub Command1_Click()
Dim FileName As String
Dim Xstr As String, Ystr As String
On Error GoTo errhandle
CommonDialog1.InitDir = App.Path '设置初始路径 数据导入
CommonDialog1.FileName = "" '清除文件名
CommonDialog1.ShowOpen '显示“打开”对话框
FileName = CommonDialog1.FileName '保存文件名
If Len(CommonDialog1.FileName) > 0 Then
'File = FreeFile() '获得可用文件号
Open FileName For Input As #1 '打开文件
End If
I = 0
MousePointer = 11
Do While EOF(1) = False
I = I + 1
ReDim Preserve X(I)
ReDim Preserve Y(I)
MSFlexGrid1.Rows = I + 1
Input #1, Xstr, Ystr ' 分别输入各数据
MSFlexGrid1.TextMatrix(I, 1) = Xstr
X(I) = Val(Xstr)
MSFlexGrid1.TextMatrix(I, 2) = Ystr
Y(I) = Val(Ystr)
MSFlexGrid1.TextMatrix(I, 0) = I
Loop
Close #1: N = I '检验一下N是否对？？？
Call ZuoDian(X, Y)
errhandle:
MousePointer = 0
Exit Sub
MousePointer = 0
End Sub
Private Sub Command2_Click()
Dim Xh As Integer
M = Val(Combo1.Text) + 1
Erase B: Erase xiaoA: Erase A '必不可少***********
ReDim B(M): ReDim xiaoA(1 To M)
'形成方程组的各元素
A(1, 1) = N
For I = 1 To N
B(1) = B(1) + Y(I)
Next I
For J = 2 To M
For I = 1 To N
A(1, J) = A(1, J) + X(I) ^ (J - 1)
Next I
Next J
For I = 2 To M
For J = 1 To M
For Xh = 1 To N
A(I, J) = A(I, J) + X(Xh) ^ (I + J - 2)
If J = 1 Then
B(I) = B(I) + X(Xh) ^ (I - 1) * Y(Xh)
End If
Next Xh
Next J
Next I
Call JieFangCheng(A, B, xiaoA)
For I = 1 To M
Text1.Text = Text1.Text & "a" & I - 1 & "=" & xiaoA(I) & ";"
Next I
Dim Str As String: Str = "y="
For I = 1 To M '写方程
If I < M Then
Str = Str & xiaoA(I) & "x^" & I - 1 & "+"
Else
Str = Str & xiaoA(I) & "x^" & I - 1
End If
Next I
Text1.Text = Text1.Text & vbCrLf & "曲线方程:" & vbCrLf & Str
Call HuaQuXian(xiaoA)
End Sub
Private Sub Command3_Click()
Dim Xzhi As Single, Yzhi As Single
Xzhi = Val(Text2.Text)
Yzhi = 0
For J = 1 To M
Yzhi = Yzhi + xiaoA(J) * Xzhi ^ (J - 1)
Next J
Text3.Text = Yzhi
End Sub
Private Sub Form_Load()
For I = 0 To 2
MSFlexGrid1.ColAlignment(I) = 4
Next I
For I = 1 To 20
MSFlexGrid1.TextMatrix(I, 0) = I
Next I
End Sub
Private Sub JieFangCheng(A() As Single, B() As Single, X() As Single)
N = UBound(B)
Dim TempA As Single, L As Integer, K As Integer, Kk As Integer
Dim Ii As Integer, ChuShu As Single, Sum As Single
For I = 1 To N
L = 0: Kk = 0
For J = I To N
If A(J, I) = 0 Then L = L + 1
Next J
For J = I To N - L
If A(J, I) = 0 Then
Kk = Kk + 1
For K = I To N
TempA = A(J, K)
A(J, K) = A(N - Kk + 1, K)
A(N - Kk + 1, K) = TempA
Next K
TempA = B(J): B(J) = B(N - Kk + 1): B(N - Kk + 1) = TempA
End If
Next J
For Ii = I To N - L
ChuShu = A(Ii, I)
For J = I To N
A(Ii, J) = A(Ii, J) / ChuShu
Next J
B(Ii) = B(Ii) / ChuShu
Next Ii
For Ii = I + 1 To N - L
For J = I To N
A(Ii, J) = A(Ii, J) - A(I, J)
Next J
B(Ii) = B(Ii) - B(I)
Next Ii
Next I
For I = 1 To N
For J = 1 To I - 1
A(I, J) = 0
Next J
Next I
X(N) = B(N) / A(N, N)
For I = N - 1 To 1 Step -1
Sum = 0
For J = I + 1 To N
Sum = Sum + A(I, J) * X(J)
Next J
X(I) = (B(I) - Sum) / A(I, I)
Next I
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -