?? 最小二乘法多次曲線擬合.frm
字號(hào):
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "最小二乘法多次曲線擬合"
ClientHeight = 4455
ClientLeft = 45
ClientTop = 330
ClientWidth = 6495
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 297
ScaleMode = 3 'Pixel
ScaleWidth = 433
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "改變"
Height = 315
Index = 1
Left = 720
Style = 1 'Graphical
TabIndex = 15
Top = 0
Width = 675
End
Begin VB.CommandButton Command4
Caption = "擬合"
Height = 315
Left = 5580
Style = 1 'Graphical
TabIndex = 12
Top = 0
Width = 855
End
Begin VB.CommandButton Command2
Caption = "保存"
Height = 315
Index = 1
Left = 3480
Style = 1 'Graphical
TabIndex = 14
Top = 0
Width = 675
End
Begin VB.CommandButton Command2
Caption = "讀取"
Height = 315
Index = 0
Left = 2820
Style = 1 'Graphical
TabIndex = 13
Top = 0
Width = 675
End
Begin VB.TextBox Text4
BackColor = &H00FFFFC0&
Height = 270
Index = 1
Left = 3540
Locked = -1 'True
TabIndex = 11
ToolTipText = "輸出Y值"
Top = 4140
Width = 2895
End
Begin VB.CommandButton Command3
Caption = "->"
Height = 255
Left = 3000
Style = 1 'Graphical
TabIndex = 10
ToolTipText = "求對(duì)應(yīng)的Y值"
Top = 4140
Width = 495
End
Begin VB.TextBox Text4
BackColor = &H00FFFFC0&
Height = 270
Index = 0
Left = 60
TabIndex = 9
ToolTipText = "輸入X值"
Top = 4140
Width = 2895
End
Begin VB.TextBox Text3
BackColor = &H00FFFFC0&
Height = 270
Left = 60
Locked = -1 'True
TabIndex = 8
ToolTipText = "曲線函數(shù)表達(dá)式"
Top = 3840
Width = 6375
End
Begin VB.CommandButton Command1
Caption = "清除"
Height = 315
Index = 3
Left = 2100
Style = 1 'Graphical
TabIndex = 5
Top = 0
Width = 675
End
Begin VB.CommandButton Command1
Caption = "刪除"
Height = 315
Index = 2
Left = 1440
Style = 1 'Graphical
TabIndex = 4
Top = 0
Width = 675
End
Begin VB.TextBox Text2
BackColor = &H00FFFFC0&
Height = 270
Left = 4200
Locked = -1 'True
TabIndex = 7
ToolTipText = "相關(guān)系數(shù)"
Top = 360
Width = 2235
End
Begin VB.ListBox List3
BackColor = &H00FFFFC0&
Height = 3120
Left = 4200
TabIndex = 6
ToolTipText = "回歸系數(shù)列表"
Top = 660
Width = 2235
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 315
Index = 0
Left = 60
Style = 1 'Graphical
TabIndex = 3
Top = 0
Width = 675
End
Begin VB.TextBox Text1
BackColor = &H00FFFFC0&
Height = 255
Left = 60
TabIndex = 2
Text = "0,0"
ToolTipText = "數(shù)據(jù)輸入"
Top = 360
Width = 3555
End
Begin VB.ListBox List2
BackColor = &H00FFFFC0&
Height = 3120
Left = 60
TabIndex = 1
ToolTipText = "數(shù)據(jù)列表"
Top = 660
Width = 3555
End
Begin VB.ListBox List1
BackColor = &H00FFFFC0&
Height = 2955
IntegralHeight = 0 'False
Left = 3660
MultiSelect = 1 'Simple
TabIndex = 0
ToolTipText = "回歸函數(shù)表達(dá)式包含的次數(shù)(可多選)"
Top = 840
Width = 555
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click(Index As Integer)
Dim s1 As String, z1 As Long
Select Case Index
Case 0
s1 = DelSpace(Text1.Text)
z1 = InStr(s1, ",")
If z1 > 0 And z1 < Len(s1) Then
s1 = StrEX(ValEX(Left(s1, z1))) & "," & StrEX(ValEX(Mid(s1, z1 + 1)))
List2.AddItem s1
End If
'List2.ListIndex = List2.ListCount - 1
Case 1
If List2.ListIndex >= 0 Then
s1 = DelSpace(Text1.Text)
z1 = InStr(s1, ",")
If z1 > 0 And z1 < Len(s1) Then
s1 = StrEX(ValEX(Left(s1, z1))) & "," & StrEX(ValEX(Mid(s1, z1 + 1)))
List2.List(List2.ListIndex) = s1
End If
End If
Case 2
If List2.ListIndex >= 0 Then
z1 = List2.ListIndex
List2.RemoveItem List2.ListIndex
If z1 >= List2.ListCount Then z1 = List2.ListCount - 1
If z1 >= 0 Then List2.ListIndex = z1
End If
Case 3
List2.Clear
End Select
Command4.Enabled = List2.ListCount > List1.SelCount
End Sub
Private Sub Command2_Click(Index As Integer)
Dim s1 As String, z1 As Long
Select Case Index
Case 0
Me.Tag = "open"
Load Dialog
Dialog.Show 1
If Len(Me.Tag) = 0 Then Exit Sub
Open Me.Tag For Input As #1
Do Until EOF(1)
Line Input #1, s1
s1 = DelSpace(s1)
z1 = InStr(s1, ",")
If z1 > 0 And z1 < Len(s1) Then
s1 = StrEX(ValEX(Left(s1, z1))) & "," & StrEX(ValEX(Mid(s1, z1 + 1)))
List2.AddItem s1
End If
List2.ListIndex = List2.ListCount - 1
Loop
Close #1
Command4.Enabled = List2.ListCount > List1.SelCount
Case 1
Me.Tag = "save"
Load Dialog
Dialog.Show 1
If Len(Me.Tag) = 0 Then Exit Sub
z1 = 0
If Len(Dir(Me.Tag)) > 0 Then z1 = MsgBox("覆蓋此文件嗎", vbYesNo)
If z1 = vbNo Then Exit Sub
On Error Resume Next
Open Me.Tag For Output As #1
If Err.Number <> 0 Then GoTo ED
For z1 = 0 To List2.ListCount - 1
Print #1, List2.List(z1)
Next
Close #1
Exit Sub
On Error GoTo 0
ED:
Call MsgBox("Could not save", 48)
Err.Clear
End Select
End Sub
Private Sub Command3_Click()
Dim d1 As Double, d2 As Double
Dim z1 As Long, z2 As Long, z3 As Long, z4 As Long
d2 = ValEX(Text4(0).Text): z4 = List1.SelCount
'If z4 + 1 = List3.ListCount Then
On Error GoTo ED
d1 = ValEX(List3.List(0))
z3 = 0
For z2 = 0 To z4 - 1
z3 = z3 + 1
BegIF1:
If List1.Selected(z3 - 1) = False Then z3 = z3 + 1: GoTo BegIF1
d1 = d1 + ValEX(List3.List(z2 + 1)) * d2 ^ z3
Next
Text4(1).Text = StrEX(d1)
'Else
' Call MsgBox("無(wú)效指令", 48, "錯(cuò)誤")
'End If
Exit Sub
ED:
Call MsgBox("發(fā)生錯(cuò)誤", 48, "錯(cuò)誤")
End Sub
Private Sub Command4_Click()
Dim z1 As Long, z2 As Long
Dim hRoot(16) As Double, hMaxIndex As Long, hData() As Double, LenData As Long
hMaxIndex = 16
For z2 = 0 To 15
If List1.Selected(z2) Then hRoot(z2 + 1) = 1
Next
LenData = List2.ListCount - 1
ReDim hData(LenData, 1) As Double
For z2 = 0 To LenData
z1 = InStr(List2.List(z2), ",") + 1
hData(z2, 0) = ValEX(Left(List2.List(z2), z1))
hData(z2, 1) = ValEX(Mid(List2.List(z2), z1))
Next
z2 = GetMINNHvalue(hRoot(), hMaxIndex, hData(), LenData + 1)
If z2 = -1 Then z1 = MsgBox("除數(shù)為0", 48, "錯(cuò)誤"): Exit Sub
If z2 = -2 Then z1 = MsgBox("溢出", 48, "錯(cuò)誤"): Exit Sub
List3.Clear
Text2.Text = z2
List3.AddItem StrEX(hRoot(0))
For z2 = 1 To hMaxIndex
List3.AddItem StrEX(hRoot(z2))
Next
Text3.Text = GetExpression
End Sub
Private Sub Form_Load()
Dim z1 As Long
For z1 = 0 To 15
List1.AddItem z1 + 1
Next
For z1 = 0 To 1
List1.Selected(z1) = True
Next
End Sub
Private Sub List1_Click()
Command4.Enabled = List2.ListCount > List1.SelCount
End Sub
Private Sub List2_Click()
If List2.ListIndex >= 0 Then Text1.Text = List2.List(List2.ListIndex)
End Sub
Private Function GetExpression() As String
Dim z1 As Long, z2 As Long
Dim s1 As String, s2 As String, d1 As Double, d2 As Double
z2 = List3.ListCount - 1
'If z2 = 0 Then GetExpression = "": Exit Function
s1 = StrEX(ValEX(List3.List(0)))
'If z2 = 1 Then GetExpression = "y=" & s1: Exit Function
d1 = ValEX(List3.List(1))
d2 = ValEX(List3.List(0))
If d1 <> 0 Then
If d2 < 0 Then s2 = "" Else s2 = "+"
Select Case d1
Case 1
s1 = "x" & s2 & s1
Case -1
s1 = "-x" & s2 & s1
Case Else
s1 = StrEX(d1) & "x" & s2 & s1
End Select
End If
For z1 = 2 To z2
d1 = ValEX(List3.List(z1))
d2 = ValEX(List3.List(z1 - 1))
If d1 <> 0 Then
If d2 < 0 Then s2 = "" Else s2 = "+"
Select Case d1
Case 1
s1 = "x^" & StrEX(z1) & s2 & s1
Case -1
s1 = "-x^" & StrEX(z1) & s2 & s1
Case Else
s1 = StrEX(d1) & "x^" & StrEX(z1) & s2 & s1
End Select
End If
Next
If Len(s1) <= 1 Then GetExpression = "y=" & s1: Exit Function
If Right(s1, 2) = "+0" Then
GetExpression = "y=" & Left(s1, Len(s1) - 2)
Else
GetExpression = "y=" & s1
End If
End Function
Private Function DelSpace(ByVal Text As String) As String
Dim z1 As Long, z2 As Long, z3 As Long
z2 = Len(Text): z3 = Len(Text)
For z1 = 1 To z2
If Asc(Mid(Text, z1, 1)) = 32 Then Mid(Text, z1) = Mid(Text, z1 + 1): z3 = z3 - 1
Next z1
DelSpace = Left(Text, z3)
End Function
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command1_Click(1)
End Sub
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -