form1.frm

本程序提供了输入表达式计算、积分、微分、拟合、插值等多种数值计算

End Sub

Private Sub Command10_Click()
MSFlexGrid2.TextMatrix(1, 1) = ""
MSFlexGrid2.TextMatrix(2, 1) = ""
MSFlexGrid2.Cols = 2

End Sub

Private Sub Command11_Click()
On Error GoTo handle
Dim m As Single, n As Single
m = MSFlexGrid2.Cols - 2
ReDim x(m), y(m)
For i = 0 To m
 x(i) = MSFlexGrid2.TextMatrix(1, i + 1)
Next i
For i = 0 To m
 y(i) = MSFlexGrid2.TextMatrix(2, i + 1)
Next i

aa = 0
Dim k As Single
For i = 0 To m
aa = aa + y(i)
Next i
aa = aa / (m + 1)
bb = 0
For i = 0 To m
bb = bb + (y(i) - aa) ^ 2
Next i

If Option5.Value = True Then

biaozi = 1
n = InputBox("请输入拟合次多项式数n", "输入n", 1)
ReDim h(n)

Call nh(h(), m, n, x(), y())
cc = 0
For i = 0 To m
cc = cc + (y(i) - duoxs(h(), n, x(i))) ^ 2
Next i
r = 1 - cc / bb
Text5.Text = ""
For i = 0 To n
If i = 0 Then
Text5.Text = Text5.Text & "Y=" & h(0) & " + "
ElseIf i > 0 And i < n Then
Text5.Text = Text5.Text & "(" & h(i) & ")X^" & i & "+"
ElseIf i = n Then
Text5.Text = Text5.Text & "(" & h(n) & ")X^" & i
End If
Next i
Text5.Text = Text5.Text & Chr(13) + Chr(10)

Text5.Text = Text5.Text & "r=" & r
ElseIf Option6.Value = True Then
biaozi = 2
n = 1
ReDim h(n)
For i = 0 To m
y(i) = Log(y(i))
x(i) = Log(x(i))
Next i
Call nh(h(), m, n, x(), y())
h(0) = Exp(h(0))
For i = 0 To m
y(i) = Exp(y(i))
x(i) = Exp(x(i))
Next i
cc = 0
For i = 0 To m
cc = cc + (y(i) - cm(h(0), h(1), x(i))) ^ 2
Next i
r = 1 - cc / bb
Text5.Text = ""

Text5.Text = Text5.Text & "y=" & h(0) & "x^" & "(" & h(1) & ")" & Chr(13) + Chr(10)
Text5.Text = Text5.Text & r


ElseIf Option7.Value = True Then
biaozi = 3
n = 1
ReDim h(n)
For i = 0 To m

x(i) = Log(x(i))
Next i
Call nh(h(), m, n, x(), y())
For i = 0 To m

x(i) = Exp(x(i))
Next i
For i = 0 To m
cc = cc + (y(i) - duis(h(0), h(1), x(i))) ^ 2
Next i
r = 1 - cc / bb
Text5.Text = ""

Text5.Text = Text5.Text & "y=" & h(1) & "Log(X)+" & "(" & h(0) & ")"



ElseIf Option8.Value = True Then
biaozi = 4
n = 1
ReDim h(n)
For i = 0 To m
y(i) = Log(y(i))
Next i
Call nh(h(), m, n, x(), y())
h(0) = Exp(h(0))
For i = 0 To m
y(i) = Exp(y(i))
Next i
cc = 0
For i = 0 To m
cc = cc + (y(i) - zhis(h(0), h(1), x(i))) ^ 2
Next i
r = 1 - cc / bb

Text5.Text = ""

Text5.Text = Text5.Text & "y=" & h(0) & "Exp(" & h(1) & "X)"




End If
Command12.Enabled = True
handle:
If Err.Number <> 0 Then
End If







End Sub

Private Sub Command12_Click()
Form2.Show 1
Command12.Enabled = False
End Sub

Private Sub Command13_Click()
Dim a As Double, b As Double, c As Double
st = Text6.Text
a = Val(Text7.Text)
b = Val(Text8.Text)
c = Val(Text9.Text)
If f(a) * f(b) > 0 Then
  MsgBox "在此区间中没解"
  Exit Sub
End If
Do
 If f((a + b) / 2) = 0 Then
   x1 = (a + b) / 2
   Text10.Text = x1
   'Text1.Text = f((a + b) / 2)
   Exit Sub
 Else
   If f(a) * f((a + b) / 2) < 0 Then
     b = (a + b) / 2
   Else
     a = (a + b) / 2
   End If
  End If
  Loop While Abs(b - a) > c
  x1 = (a + b) / 2
  Text10.Text = x1
End Sub

Private Sub Command14_Click()
Dim a As Double
Dim b As Double
Dim x1 As Double
Dim x2 As Double

st = Text13.Text
a = Val(Text14.Text)
b = Val(Text15.Text)
E = 0.00001
x1 = a + 0.618 * (b - a)
x2 = b - 0.618 * (b - a)
Do
  If f(x1) > f(x2) Then
    b = x1
    x1 = x2
    x2 = b - 0.618 * (b - a)
 Else
a = x2
x2 = x1
x1 = a + 0.618 * (b - a)
End If
Loop While Abs(b - a) > E
 If f(x1) > f(x2) Then
  Text16.Text = f(x2)
  Text17.Text = x2
 Else
   Text16.Text = f(x1)
   Text17.Text = x1
End If

End Sub

Private Sub Command15_Click()
Dim a As Double
st = Text22.Text
a = Val(Text21.Text)
f1 = 4 / 3 * (f(0.0001 / 2 + a) - f(-0.0001 / 2 + a)) / 0.0001 - 1 / 6 * (f(0.0001 + a) - f(-0.0001 + a)) / 0.0001
Text18.Text = f1
End Sub

Private Sub Command16_Click()
Dim a As Double, b As Double
st = Text23.Text
a = Val(Text25.Text)
b = Val(Text24.Text)
E = Val(Text26.Text)
n = 1
h1 = b - a
s = 0
p = (f(a) + f(b)) / 2
t2 = p * h1
s2 = t2
c2 = t2
r2 = t2
Do
  t1 = t2
  s1 = s2
  c1 = c2
  r1 = r2
  h1 = 0.5 * h1
  For i = 1 To 2 * n - 1 Step 2
   s = s + f(a + i * h1)
  Next i
  t2 = (p + s) * h1
  s2 = t2 + (t2 - t1) / 3
  c2 = s2 + (s2 - s1) / 15
  r2 = c2 + (c2 - c1) / 63
  n = n + n
  Loop While (Abs(r1 - r2) > E) And n <= 10000
  Text27.Text = r2
End Sub

Private Sub Command17_Click()
Form3.Show 1
Command17.Enabled = False
End Sub

Private Sub Command18_Click()
On Error GoTo handle
Dim p As Single, n As Single, m As Single, d1 As Single, d2 As Single
m = MSFlexGrid4.Cols - 2
k = MSFlexGrid3.Cols - 1
ReDim x(m), y(m), xx1(k), yy1(k)


For i = 0 To m
 x(i) = MSFlexGrid4.TextMatrix(1, i + 1)
 y(i) = MSFlexGrid4.TextMatrix(2, i + 1)
Next i
For i = 1 To k
 xx1(i) = MSFlexGrid3.TextMatrix(1, i)
 
Next i




If Option12.Value = True Then
biaozi = 1
nn = InputBox("请输入插值的次数n", " 输入n", 1)
'u = InputBox("请输入未知点u", " 输入u", 1)

For i = 1 To k
Call ntcz(x(), y(), p, xx1(i), nn, m)

yy1(i) = p

MSFlexGrid3.TextMatrix(2, i) = yy1(i)

Next i


ElseIf Option11.Value = True Then
 biaozi = 2
d1 = InputBox("请输入边界条件fo'", " 输入fo'", 1)
d2 = InputBox("请输入边界条件fn'", " 输入fn'", 1)
'u = InputBox("请输入未知点u", " 输入u", 1)
For i = 1 To k
Call yangt(1, x(), y(), d1, d2, xx1(i), p, m)

yy1(i) = p

MSFlexGrid3.TextMatrix(2, i) = yy1(i)

Next i





ElseIf Option10.Value = True Then
biaozi = 3
d1 = InputBox("请输入边界条件fo'' ", " 输入fo''", 1)
d2 = InputBox("请输入边界条件fn''", " 输入fn''", 1)
'u = InputBox("请输入未知点u", " 输入u", 1)

For i = 1 To k
Call yangt(1, x(), y(), d1, d2, xx1(i), p, m)

yy1(i) = p

MSFlexGrid3.TextMatrix(2, i) = yy1(i)

Next i

End If



Command17.Enabled = True



handle:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
Command17.Enabled = True
End Sub

Private Sub Command19_Click()
MSFlexGrid4.TextMatrix(1, 1) = ""
MSFlexGrid4.TextMatrix(2, 1) = ""
MSFlexGrid4.Cols = 2
MSFlexGrid3.TextMatrix(1, 1) = ""
MSFlexGrid3.TextMatrix(2, 1) = ""
MSFlexGrid3.Cols = 2
End Sub

Private Sub Command2_Click()
Dim bds As New CalExp
Text2.Text = bds.CalExpression(Text1.Text, 0)
End Sub

Private Sub Command20_Click()
m = MSFlexGrid4.Rows - 1
n = MSFlexGrid4.Cols - 1
Text29.Text = ""
CommonDialog1.ShowSave
If CommonDialog1.FileName = "" Then Exit Sub
Open CommonDialog1.FileName For Output As #1
For i = 1 To m
For j = 1 To n
Text29.Text = Text29.Text + MSFlexGrid4.TextMatrix(i, j) + " "
Next j
Text29.Text = Text29.Text + Chr(13) + Chr(10)
Next i
Print #1, Text29.Text
Close #1
End Sub

Private Sub Command21_Click()
Text29.Text = ""
CommonDialog1.ShowOpen
k = 0
If CommonDialog1.FileName = "" Then Exit Sub
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
  Input #1, aa
  k = k + 1

Loop
Close #1
k = k - 1
m = 0
Open CommonDialog1.FileName For Input As #2
Do While Not EOF(2)
 Line Input #2, aa
  m = m + 1
  
Loop
m = m - 1
Close #2
n = k / m
 MSFlexGrid4.Rows = m + 1
 MSFlexGrid4.Cols = n + 1
Open CommonDialog1.FileName For Input As #3
For i = 1 To m
For j = 1 To n

Input #3, aaa
MSFlexGrid4.TextMatrix(i, j) = aaa
Next j
'Text4.Text = Text4.Text + Chr(13) + Chr(10)
Next i
'Print #1, Text4.Text
Close #3
End Sub

Private Sub Command22_Click()
Dim a As Double
st = Text22.Text
a = Val(Text20.Text)
f1 = 4 / 3 * (f(0.0001 / 2 + a) - f(-0.0001 / 2 + a)) / 0.0001 - 1 / 6 * (f(0.0001 + a) - f(-0.0001 + a)) / 0.0001
f2 = 1 / 3 / 0.0001 ^ 2 * (16 * f(0.0001 / 2 + a) + 16 * f(-0.0001 / 2 + a) - f(0.0001 + a) - f(-0.0001 + a) - 30 * f(a))

Text31.Text = f2
End Sub

Private Sub Command3_Click(Index As Integer)
 Select Case Index
   Case 0 To 9
   Text1.Text = Text1.Text & Index
   Case 10
   Text1.Text = Text1.Text & "."
    Case 11
    Text1.Text = Text1.Text & "%"
    Case 12
    Text1.Text = Text1.Text & "+"
    Case 13
    Text1.Text = Text1.Text & "-"
    Case 14
    Text1.Text = Text1.Text & "*"
    Case 15
    Text1.Text = Text1.Text & "/"
    Case 16
    Text1.Text = Text1.Text & "("
    Case 17
    Text1.Text = Text1.Text & ")"
    Case 18