高精度大数据一元三次方程求解程序 - VB6论坛

得分:0

下面发一下代码（太长如果一次传不了，就分段传）：

Dim sng As Integer 'shuru zifu & '"√"41420
'具体方法是:先切换到非英语输入法(如:五笔/拼音),
'然后在输入法的状态栏上看到像键盘一样的按钮,在按钮上按右键,选"希腊字母",
'根着你就可在软键盘上看到你要的符号了.
'2"178",3"179",×"215",÷"247",°"176"

Private Sub Command1_Click()
Dim ja, jb, jc
k = DeleteSpace(Text1.Text)
ja = DeleteSpace(Text2.Text)
jb = DeleteSpace(Text3.Text)
jc = DeleteSpace(Text7.Text)
sd1 = DeleteSpace(Text10.Text)
If Abs(Val(sd1)) <= 10 Then
sd = 10 + 2
Else
If Len(sd1) > 3 And Abs(Val(sd1)) > 300 Then
sd = 300 + 2
Else
sd = Int(Abs(Val(sd1))) + 2
End If
End If

a2 = zhengliys2(Trim(ja), Val(sd))


b2 = zhengliys2(Trim(jb), Val(sd))

C2 = zhengliys2(Trim(jc), Val(sd))
k2 = zhengliys2(Trim(k), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
Text4.Text = "a 不能为 0"
   Text5.Text = "a 为 0可能已不是1元3次方程"
  Else

a3 = mcc2(Trim(a2), Trim(k2), Val(sd))
b3 = mcc2(Trim(b2), Trim(k2), Val(sd))
C3 = mcc2(Trim(C2), Trim(k2), Val(sd))



   ' m = 36 * Val(ja) * Val(jb) - 8 * Val(ja) ^ 3 - 108 * Val(jc)
   If mbjc2(Trim(a3), 0) = 0 And mbjc2(Trim(b3), 0) = 0 Then
   m = mbc2(-108 & String(sd, "0"), Trim(C3), Val(sd))

   n4 = qdfh(mbc2(Trim(m), Trim(m), Val(sd)))
   Else

   m1 = mbc2(mbc2(Trim(a3), Trim(b3), Trim(sd)), Val(36) & String(sd, "0"), Val(sd))
   m2 = mbc2(mbc2(mbc2(Trim(a3), Trim(a3), Trim(sd)), Trim(a3), Val(sd)), Val(8) & String(sd, "0"), Val(sd))
   m3 = mbc2(Trim(C3), Val(108) & String(sd, "0"), Val(sd))
   m = mpc2(mpc2(Trim(m1), Trim(m2)), Trim(m3))
  Print "m="; m

'n1 = Val(m) ^ 2 + (12 * Val(B) - 4 * Val(A) ^ 2) ^ 3

  n1 = mbc2(Trim(m), Trim(m), Val(sd))
    n2 = mpc2(mbc2(Trim(b3), Val(12) & String(sd, "0"), Val(sd)), mbc2(mbc2(Trim(a3), Trim(a3), Val(sd)), Val(4) & String(sd, "0"), Val(sd)))
     n3 = mbc2(mbc2(Trim(n2), Trim(n2), Val(sd)), Trim(n2), Val(sd))
     n4 = mpc3(Trim(n1), Trim(n3))
     End If
     fn4 = fhys(Trim(n4))
    n5 = mbbc2(qqdl(qdfh(Trim(n4))), Val(sd))
   Print "n5="; n5

    'If n1 < 0 And m < 0 Then
    If Val(fn4) < 0 And Val(fhys(Trim(m))) < 0 Then
    'n=(93312R^6+311040R^5+285120R^4+221824R^3+27020R^2+3712R+320)^(1/2)
    'a=-(2+81k)
    'm=216r^3+360r^2+128r-8
    'k=(n^2/m^2)/27
    ''a1=(M/8*(9t-1))^(1/3),,b1=a1*(t)^(1/2)
    '令m=19683N^6+1215N^4M^2+17N^2M^4-M^6,
'm1=243N^4+3N^2M^2+M^4,
'n=(m^2-m1^3)^(1/2),
'则:t=(((m+n)^(1/3)+(m-n)^(1/3))+(2*M^2+3*N^2))/(3*M^2),
''其中M≠m，N≠n，
   jq = mbbc3(mbbc2(qqdl(MPC1(mbc2(qdfh(Trim(m)), qdfh(Trim(m)), Val(sd)), mbc2(qdfh(Trim(n5)), qdfh(Trim(n5)), Val(sd)))), Val(sd)), Val(sd))
   jq3 = mcc2(Trim(n5), Trim(m), Val(sd))
   jq1 = jsfanzq(mcc2(Trim(n5), Trim(m), Val(sd)), Val(sd))
   Print "jq3="; jq3
   Print "jq1="; jq1
   q1 = mbc2(Trim(jq), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), Val(sd))

   Print "q1="; q1

   If Val(fhys(Trim(q1))) > 0 Then
  q = tjfh(Trim(q1), Val(-1))
  Else
  q = qdfh(Trim(q1))
  End If
   jq3 = mbbc2(MPC(1 & String(sd, "0"), mbc2(jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), _
   Val(sd))), Val(sd))
   jq2 = tjfh(Trim(jq3), Val(-1))
   Print "jq2="; jq2

   qa = mbc2(Trim(jq), Trim(jq2), Val(sd))
   p = q
   pa = qa
  Else
  'If n1 < 0 And m > 0 Then
If Val(fn4) < 0 And MBJC(qdfh(Trim(m)), 0) > 0 Then

jq = mbbc3(mbbc2(qqdl(MPC1(mbc2(qdfh(Trim(m)), qdfh(Trim(m)), Val(sd)), mbc2(qdfh(Trim(n5)), qdfh(Trim(n5)), Val(sd)))), Val(sd)), Val(sd))
   jq1 = jsfanzq(mcc2(Trim(n5), Trim(m), Val(sd)), Val(sd))
   jq3 = mcc2(Trim(n5), Trim(m), Val(sd))
   q = mbc2(Trim(jq), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), Val(sd))
   jq2 = mbbc2(MPC(1 & String(sd, "0"), mbc2(jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), jsyuxian(mcc2(Trim(jq1), 3 & String(sd, "0"), Val(sd)), Val(sd)), _
   Val(sd))), Val(sd))
   Print "jq3="; jq3
   Print "jq1="; jq1
   Print "q"; q
   Print "jq2="; jq2
   qa = mbc2(Trim(jq), Trim(jq2), Val(sd))
   p = q
   pa = qa
Else
'If Val(m) + Val(n2) < 0 Then
If fhys(mpc3(Trim(m), Trim(n5))) = -1 Then
p = "-" & mbbc3(qdfh(mpc3(Trim(m), Trim(n5))), Val(sd))
Else
p = mbbc3(mpc3(Trim(m), Trim(n5)), Val(sd))

End If

'If Val(m) < Val(n2) Then
If mbjc2(Trim(m), Trim(n5)) = -1 Then
'q = -(Val(n2) - Val(m)) ^ (1 / 3)
q = "-" & mbbc3(qdfh(mpc2(Trim(n5), Trim(m))), Val(sd))
Else
q = mbbc3(mpc2(Trim(m), Trim(n5)), Val(sd))

End If

  End If


  End If

  'If a = 0 And b = 0 Then
  If Val(fn4) > 0 And mbjc2(Trim(n4), 0) <> 0 Then  'Val(n4) > 0 Or mbjc2(Trim(n4), 0) = 0
  tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = zhengchuqy(MCC1(qdfh(mbc2(mpc2(Trim(p), Trim(q)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd))), 12))
Text4.Text = shuchujg(Trim(tx1), Val(sd))
Text5.Text = shuchujg(Trim(tx2), Val(sd))
  Text6.Text = shuchujg(Trim(tx2), Val(sd))
  Text8.Text = shuchujg(Trim(tx3), Val(sd)) & "i"
  Text9.Text = shuchujg(Trim(tx3), Val(sd)) & "i"
  Else
  If Mid(fn4, 1, 1) = "-" And Trim(m) = 0 Or Trim(n5) = 0 Then
tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = mcc2(mbc2(mpc2(Trim(p), Trim(q)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd)), 12 & String(sd, "0"), Val(sd))
  If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  Text4.Text = shuchujg(Trim(tx1), Val(sd))
Text5.Text = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  Text6.Text = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  Text8.Text = ""
  Text9.Text = ""
  Else

  'd = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  'd = mcc2(MPC(qdfh(mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), mpc3(Trim(p), Trim(q))), 6 & String(sd, "0"), Val(sd))
  'mpc2减法器有问题？
  'fd = fhys(Trim(d))
  tx1 = mcc2(mpc2(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 2 & String(sd, "0"), Val(sd))), 6 & String(sd, "0"), Val(sd))
  ftx1 = fhys(Trim(tx1))
  tx4 = mcc2(mpc3(mpc3(Trim(p), Trim(q)), mbc2(Trim(a3), 4 & String(sd, "0"), Val(sd))), 12 & String(sd, "0"), Val(sd))
  ' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
' -(Val(p) + Val(q) + 4 * Val(A)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
tx3 = mcc2(mbc2(mpc3(Trim(pa), Trim(qa)), zhengchuqy(MBBC(3 & String(2 * Val(sd), "0"))), Val(sd)), 12 & String(sd, "0"), Val(sd))
If Val(fhys(Trim(tx4))) > 0 Then
  tx2 = tjfh(Trim(tx4), Val(-1))
  Else
  tx2 = qdfh(Trim(tx4))
  End If
  Text4.Text = shuchujg(Trim(tx1), Val(sd))
Text5.Text = shuchujg(mpc3(Trim(tx2), Trim(tx3)), Val(sd))
  Text6.Text = shuchujg(mpc2(Trim(tx2), Trim(tx3)), Val(sd))
  Text8.Text = ""
  Text9.Text = ""

  End If

End If

  End If
  Label3.Caption = Val(Label3.Caption) + 1
  Label2.Caption = "输出结果"

  If Text8.Text = "" Then
  Text11.Text = Text11.Text & "  输入" & Label3.Caption & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & ";  输出结果" & Label3.Caption & ":    " & "x1=" & Text4.Text & ",  x2=" & Text5.Text & ",  x3=" & Text6.Text _
  & " m=" & shuchujg(Trim(m), Val(sd)) & " n=" & shuchujg(Trim(n5), Val(sd)) & "i"
  Else

  Text11.Text = Text11.Text & "  输入" & Label3.Caption & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & ";  输出结果" & Label3.Caption & ":    " & "x1=" & Text4.Text & ",  x2=" & Text5.Text & "+" & Text8.Text & ",  x3=" & Text6.Text & "-" & Text9.Text _
  & " m=" & shuchujg(Trim(m), Val(sd)) & " n=" & shuchujg(Trim(n5), Val(sd))

  End If

End Sub

Private Sub Command10_Click()
Text11.Text = "1，最好输入数值 2，鲍丰武原理，王彦会程序设计 " _
& "3，编制于2013.05.02 4，有需要的请与我们联系 5，原理见《数学中国》" _
& "论坛，“风花飘飘”版作品6,兼容1元1次/2次/3次方程"
Label2.Caption = "提示2"
End Sub

Private Sub Command11_Click()
Text11.Text = ""
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End Sub

Private Function jspaizh(sd As String) As String '派/2=1+1/3+1*2/3*5+1*2*3/3*5*7+……
'应该是 Pi/4=1-1/3+1/5-1/7+…+（-1）^(n-1)/(2*n-1)吧，呵呵
'派/2=2/1*2/3*4/3*4/5^^^^^=2*2/1*3*4*4/3*5*6*6/5*7*^^^^^^^
Dim s1 As String
s1 = "31415926535 8979323846 2643383279 5028841971 6939937510 5820974944 5923078164 0628620899 8628034825 3421170679 8214808651 32823066470938446095 5058223172 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 4428810975 6659334461 2847564823 37867831652712019091 4564856692 3460348610 4543266482 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 9171536436 7892590360" _
& "0113305305 4882046652 1384146951 9415116094 3305727036 5759591953 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724" _
& "8912279381 8301194912 9833673362 4406566430 8602139494 6395224737 1907021798 6094370277 0539217176 2931767523 8467481846 7669405132" _
& "0005681271 4526356082 7785771342 7577896091 7363717872 1468440901 2249534301 4654958537 1050792279 6892589235 4201995611 2129021960" _
& "8640344181 5981362977 4771309960 5187072113 4999999837 2978049951 0597317328 1609631859 5024459455 3469083026 4252230825 3344685035"
s2 = DeleteSpace(s1)
jspaizh = zhengchuqy(MCC1(Left(s2, Val(sd) + 1), Val(2)))

End Function
Private Function zhengliys3(sa As String, sd As String) As String
fa1 = fhys(Trim(sa))
If Trim(sa) = 0 Then
zhengliys3 = 0
Else

a2 = qqdl(ydxsd(qdfh(Trim(sa)), Val(sd)))
zhengliys3 = tjfh(Trim(a2), Trim(fa1))
End If

End Function

Private Function zhengliys2(sa As String, sd As String) As String
  If sa = "" Or sa = "Text1" Or sa = "Text2" Or sa = "Text3" Or sa = "Text7" Then
  zhengliys2 = 0
Else

  If Len(sa) <= 2 And InStr(sa, "√") = 0 Then
   zhengliys2 = zhengliys3(Trim(sa), Val(sd))
    Else

If InStr(sa, "(") = 0 Then
a1 = 1
B1 = 1
sa1 = sa
Else
  If InStr(sa, "(") = 1 Then
   a1 = 1
   sa1 = Mid(sa, InStr(sa, "(") + 1, InStr(sa, ")") - 2)
   B1 = Mid(sa, InStr(sa, ")") + 2)
   Else

   a1 = Left(sa, InStr(sa, "(") - 1)
   B1 = Mid(sa, InStr(sa, ")") + 2)
   sa1 = Mid(sa, InStr(sa, "(") + 1, InStr(sa, ")") - 2 - Val(Len(a1)))
   End If
    End If
    If a1 = "+" Then
    a1 = 1
    Else
    If a1 = "-" Then
    a1 = -1
    Else
    a1 = a1
    End If
    End If



    If B1 = "" Or Val(B1) = 0 Then
B1 = 1
Else
B1 = B1
End If

    'If Val(Len(Mid(sa, InStr(sa, ")")))) = 1 Or Val(Len(Mid(sa, InStr(sa, ")")))) = 2 Then
    'b1 = 1


    If InStr(sa1, "+") = 0 And InStr(sa1, "-") = 0 Then
    sa2 = zhengliys(Trim(sa1), Val(sd))

    Else
    If InStr(sa1, "+") = 1 Or InStr(sa1, "-") = 1 Then
    sa3 = Mid(sa1, 2)
    Else
    sa3 = sa1
    End If


   Do While InStr(sa3, "+") > 0 Or InStr(sa3, "-") > 0


   If InStr(sa3, "+") < InStr(sa3, "-") And InStr(sa3, "+") >= 1 Then
      If sa3 = sa1 Then
      sa4 = Left(sa1, InStr(sa3, "+") - 1)
      Else

   sa4 = Left(sa1, InStr(sa3, "+"))
   End If
   sa1 = Mid(sa3, InStr(sa3, "+"))
   Else
   If InStr(sa3, "-") < InStr(sa3, "+") And InStr(sa3, "-") >= 1 Then
   sa4 = Left(sa1, InStr(sa3, "-"))
   sa1 = Mid(sa3, InStr(sa3, "-"))
   Else
   If InStr(sa3, "-") = 0 And InStr(sa3, "+") > 0 Then
   sa4 = Left(sa1, InStr(sa3, "+"))
   'sa1 = Mid(sa3, InStr(sa3, "+") + Val(Len(a1)) - Val(Len(a3)))
   sa1 = Mid(sa3, InStr(sa3, "+"))
   Else
   If InStr(sa3, "-") > 0 And InStr(sa3, "+") = 0 Then
   sa4 = Left(sa1, InStr(sa3, "-"))
   sa1 = Mid(sa3, InStr(sa3, "-"))
   End If
   End If
   End If
   End If
   sa2 = mpc3(zhengliys(Trim(sa4), Val(sd)), Trim(sa2))
If InStr(sa1, "+") = 1 Or InStr(sa1, "-") = 1 Then
    sa3 = Mid(sa1, 2)
    Else
    sa3 = sa1
    End If
sa1 = sa1
Print sa4

   Loop
   Print sa1
  sa2 = mpc3(Trim(sa2), zhengliys(Trim(sa1), Val(sd)))
  Print sa2
  End If
zhengliys2 = mcc2(mbc2(zhengliys(Trim(a1), Val(sd)), Trim(sa2), Val(sd)), zhengliys(Trim(B1), Val(sd)), Val(sd))

End If
End If
End Function

Private Function zhengliys(sa As String, sd As String) As String
js = Right(sa, 1)
If js = "+" Or js = "-" Then
sa = Mid(sa, 1, Len(sa) - 1)
Else
sa = sa
End If

If InStr(sa, "/") = 0 Then
B1 = 1
a2 = sa
  Else
   B1 = Mid(sa, InStr(sa, "/") + 1)
   a2 = Left(sa, InStr(sa, "/") - 1)
    End If
If B1 = "" Or Val(B1) = 0 Then
B1 = 1
Else
B1 = B1
End If

   If InStr(a2, "√") = 0 Then
    C1 = a2
    a1 = 1
    Else
   If InStr(a2, "√") = 1 Then
  C1 = 1
  a1 = Mid(a2, InStr(a2, "√") + 1)
Else
C1 = Left(a2, InStr(a2, "√") - 1)
If Len(C1) = 1 And InStr(C1, "-") = 1 Then
C1 = -1
Else
If Len(C1) = 1 And InStr(C1, "+") = 1 Then
C1 = 1
Else
C1 = C1
End If
End If

a1 = Mid(a2, InStr(a2, "√") + 1)
  End If
  End If
  a1 = zhengliys3(Trim(a1), Val(sd))


  B1 = zhengliys3(Trim(B1), Val(sd))
  C1 = zhengliys3(Trim(C1), Val(sd))


  zhengliys = mcc2(mbc2(mbbc2(Trim(a1), Val(sd)), Trim(C1), Val(sd)), Trim(B1), Val(sd))

End Function

Private Function jsfanzq(sa As String, sd As String) As String
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 0 Then
jsfanzq = zhengchuqy(MCC1(jspaizh(sd), Val(2)))
Else
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
sa1 = zhengchuqy(MCC1(1 & String(2 * Val(sd), "0"), qdfh(Trim(sa))))
Else
sa1 = qdfh(Trim(sa))
End If

Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa1), Trim(sa1), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), Val(s3))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), Val(s3))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)

Loop

js4 = mbc2(Trim(sa1), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
fsa = fhys(Trim(sa))
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsfanzq = tjfh(mpc2(jspaizh(sd), Trim(js4)), Val(fsa))
Else
  jsfanzq = tjfh(Trim(js4), Val(fsa))
  End If
End If
End Function

Private Function jsyuxian(sa As String, sd As String) As String
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsyuxian = jszhxian(MPC(jspaizh(Val(sd)), qdfh(Trim(sa))), Val(sd))
Else
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 2
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)

Loop

jsyuxian = mpc3(Val(1) & String(Val(sd), "0"), Trim(s))
End If
End Function

Private Function jszhxian(sa As String, sd As String) As String
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)

Loop

jszhxian = mbc2(Trim(sa), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
End Function

Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If

End Function

Private Function tjxsd(sa As String, sd As String) As String
If Val(Len(sa)) > Val(sd) Then
tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
Else
If Val(Len(sa)) = Val(sd) Then
  tjxsd = "0." & sa
  Else
  tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
  End If
  End If

End Function

Public Function MBBC(D1 As String) As String 'kai pingfang
If Len(D1) < 10 Then
jss = Int(Sqr(Val(D1)))
JW = Val(D1) - (jss) ^ 2
If JW = 0 Then
MBBC = jss
Else
MBBC = jss & "/" & JW
   End If
Else
Dim X 'shuju changdu
X = Len(D1) \ 4
D2 = String(4 - Len(D1) + 4 * X, "0") & D1
Dim A() As String
ReDim A(4 To 4 * X + 4)
Dim B() As String
ReDim B(2 To 2 * X)
Dim I, J, js
For I = 4 To 4 * X + 4 Step 4

A(I) = Mid(D2, I - 3, 4)
js = Int(Sqr(Val(A(4) & A(8))))
JW = Val(A(4) & A(8)) - (js) ^ 2
Next
  J = 4
  Do While J <= 2 * X

  jws = MPC1(JW & "0000", A(2 * J + 4))
  If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then
   B(J) = "00"
   Else
   jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2)
   If Len(jwc) > 2 Then
    B(J) = 99
    Else
    B(J) = jwc
    End If


    Do While MBJC(Trim(jws), MbC(MPC1(B(J), MbC(Trim(js), 200)), B(J))) = -1

    B(J) = B(J) - 1

              Loop
         End If
         JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(J)), B(J)))

    js = MPC1(MbC(Trim(js), 100), Trim(B(J)))


  J = J + 2
  If JW = 0 Then

  MBBC = js
  Else
  MBBC = js & "/" & JW
  End If
  Loop

End If
End Function
Public Function MBJC(D1 As String, D2 As String) As String 'bijiao
If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) And Len(D1) >= 10 Then

Dim X, Y
X = Len(D1) \ 4: Y = Len(D2) \ 4
Dim A() As String, B() As String
ReDim A(4 To 4 * X + 4)
ReDim B(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * X)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
MBJC = 1
Else
If Val(Left(D1, Len(D1) - 4 * X)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
MBJC = -1
Else
For I = 4 To 4 * X Step 4
A(I) = Mid(D1, Len(D1) - I + 1, 4)
B(I) = Mid(D2, Len(D2) - I + 1, 4)
Next
J = 4 * X
Do While A(J) = B(J) And J >= 8

J = J - 4
    Loop


  If Val(A(J)) - Val(B(J)) > 0 Then
  MBJC = 1
  Else
  If Val(A(J)) - Val(B(J)) < 0 Then
  MBJC = -1
  Else
  MBJC = 0
  End If

End If

End If
End If
End If
If Len(D1) < 10 Then
ja = Val(D1) - Val(D2)
  If ja > 0 Then
   MBJC = 1
   Else
    If ja = 0 Then
     MBJC = 0
    Else

  MBJC = -1
End If
End If
End If

End If
End If
End Function

Public Function MbC(D1 As String, D2 As String) As String
Dim j1&, j2&, e&, d&, e1&, m, n

   ' 按列法计算C=A*B
m = Trim(D1): n = Trim(D2)
X = Len(m) \ 4: Y = Len(n) \ 4
m = String(4 * X + 4 - Len(m), "0") & m
n = String(4 * Y + 4 - Len(n), "0") & n
X = X + 1: Y = Y + 1
Dim A(), B()
ReDim A(1 To X): ReDim B(1 To Y)
For i1 = 1 To X
A(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To Y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = X: mb = Y
    MC = ma + mb
    ReDim c(MC)
    e1 = 0
    j1 = ma: j2 = ma
    For I = MC To 2 Step -1
        If I <= ma Then j2 = I - 1
        e = e1: e1 = 0
        For J = j1 To j2
            e = e + A(J) * B(I - J)
            If e > 2040000000 Then '减少进位次数
                e = e - 2040000000
                e1 = e1 + 204000
            End If
        Next J

        If j1 > 1 Then j1 = j1 - 1
base = 10000
        d = e \ base
        c(I) = e - d * base
        If Len(c(I)) < 4 Then
        c(I) = String(4 - Len(c(I)), "0") & c(I)
        Else
        c(I) = c(I)
        End If
jc = c(I) & jc
        e1 = e1 + d
    Next I
    jc = d & jc
   MbC = qqdl(Trim(jc))
End Function

Private Function qqdl(sa As String) As String


  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(sa, I)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
End If
End Function
Public Function MPC(D1 As String, D2 As String) As String 'jianfaqi
Dim X, Y '两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
X = Len(d3): Y = Len(D4)
Dim A() As Integer, B1() As Integer, C1() As Integer, e1() As Integer
ReDim A(1 To X)
ReDim B1(1 To Y)
ReDim C1(1 To X)
ReDim e1(1 To X)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 1 'yu jie weichuzhi
B1(J) = Mid$(D4, J, 1) '每位数
For I = X To 1 Step -1  'D1
  A(I) = Mid$(d3, I, 1) '每位数
  C1(I) = 10 + A(I) - B1(I) - 1 + JW '计算jia
  JW = C1(I) \ 10
  e1(I) = C1(I) Mod 10
Next
Next
For r = 1 To X
MPC = MPC & e1(r)
For I = 1 To Len(MPC)
   If Not Mid(MPC, I, 1) = "0" Then
       Exit For
   End If
Next
strTmp = Mid(MPC, I)
If Len(strTmp) = 0 Then
MPC = "0"
Else
MPC = strTmp
End If
Next

End Function

Public Function DeleteSpace(Tmp As String) As String
   Dim Inst As Integer
   Do
       Tmp = Replace(Tmp, " ", "")
       DoEvents
       Inst = InStr(Tmp, " ")
   Loop While Inst > 0
   DeleteSpace = Tmp
End Function

Public Function MCC1(D1 As String, D2 As String) As String '大整数的除法
Dim ss
ss = MBJC(D1, D2)
If ss = -1 Then
MCC1 = "0" & "/" & D1
Else
If ss = 0 Then
MCC1 = 1
Else
If Len(D1) = Len(D2) Then
s = Val(Left(D1, 1)) \ Val(Left(D2, 1))

Do While MBJC(MbC(Trim(s), Trim(D2)), D1) = 1
  s = s - 1
  Loop
  If MBJC(MbC(Trim(s), Trim(D2)), D1) = 0 Then
   MCC1 = s
   Else
   MCC1 = s & "/" & MPC(Trim(D1), MbC(Trim(s), Trim(D2)))

End If

  Else
  If Len(D2) < 9 Then
   MCC1 = MCC(D1, D2)
   Else
  Dim X, Y '定义分段长度
  X = Len(D1): Y = Len(D2)

Dim JW, jcc, jss, jcs
Dim A() As String, B() As String

ReDim A(1 To X)
ReDim B(1 To Y)
For I = 1 To X
A(I) = Mid(D1, I, 1)
Next
For J = 1 To Y
B(J) = Mid(D2, J, 1)
Next
jcc = Val(A(1) & A(2)) \ Val(B(1) & B(2))



jss = MbC(Trim(jcc), D2)
For i1 = 1 To Y
  jws = jws & A(i1)
    Next
JW = MPC(Trim(jws), Trim(jss))

  Z = X - Y

  Dim c() As String
  ReDim c(1 To Z)
  For s = 1 To Z
   If MBJC(JW & A(s + Y), D2) = -1 Then
     c(s) = "0"
     Else
   jwc = Val(Left(JW & A(s + Y), 3)) \ Val(Left(D2, 2))
    If Len(jwc) > 1 Then
    c(s) = "9"
     Else
      c(s) = jwc
       End If

   Do While MBJC(JW & A(s + Y), MbC(Val(c(s)), D2)) = -1
  c(s) = Right(10000 + Val(c(s) - 1), 1)
   Loop
   End If

   JW = MPC(JW & A(s + Y), MbC(Val(c(s)), D2))

  jcc = jcc & c(s)
  Next s
  If JW = 0 Then
  MCC1 = jcc
  Else
  MCC1 = jcc & "/" & JW
  End If

For I = 1 To Len(MCC1)
  If Not Mid(MCC1, I, 1) = "0" Then
      Exit For
  End If
Next
strTmp = Mid(MCC1, I)
If Len(strTmp) = 0 Then
MCC1 = "0"
Else
MCC1 = strTmp
End If



  End If






End If
End If
End If
End Function

Public Function MCC(D1 As String, D2 As String) As String '除数少于8位的除法
If Len(D1) < Len(D2) Then
MCC = "0" & "/" & D1
Else
If Len(D1) < 9 Then
  ja = Val(D1) \ Val(D2)
  If Val(D1) - (Val(D1) \ Val(D2)) * Val(D2) = 0 Then

  MCC = ja
  Else

  MCC = ja & "/" & Val(D1) - (Val(D1) \ Val(D2)) * Val(D2)
  End If
  Else

Dim X 'fen duan changdu
X = Len(D1)



   Dim A() As String
    ReDim A(1 To X)  '定义数组的储存空间
    For I = 1 To X Step 1  '把被除数各位放在a()中
     A(I) = Mid(D1, I, 1)


     Next I
    Dim B() As String
    JW = 0
   ReDim B(1 To X)
   For J = 1 To X Step 1
  B(J) = Val(JW & A(J)) \ Val(D2)
    JW = Val(JW & A(J)) - Val(B(J)) * Val(D2)
     Next J
     For r = 1 To X
     If JW = 0 Then
        MCC = MCC & B(r)
        Else
        CJ = CJ & B(r)
        MCC = CJ & "/" & JW

  End If

  For I = 1 To Len(MCC)
If Not Mid(MCC, I, 1) = "0" Then
     Exit For
End If
Next
strTmp = Mid(MCC, I)
If Len(strTmp) = 0 Then
MCC = "0"
Else
MCC = strTmp
End If

Next

End If

   End If



End Function
Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim X, Y '两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
X = Len(d3): Y = Len(D4)
Dim A() As Integer, B1() As Integer, C1() As Integer, e1() As Integer
ReDim A(1 To X)
ReDim B1(1 To Y)
ReDim C1(1 To X)
ReDim e1(1 To X)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = X To 1 Step -1  'D1
  A(I) = Mid$(d3, I, 1) '每位数
  C1(I) = A(I) + B1(I) + JW '计算jia
  JW = C1(I) \ 10
  e1(I) = C1(I) Mod 10
Next
Next
For r = 1 To X
If JW = 0 Then
MPC1 = MPC1 & e1(r)
Else
jc = jc & e1(r)
MPC1 = JW & jc
End If
Next

End Function

Private Function ydxsd(sa As String, sd As String) As String
If Len(sa) = 1 And Trim(sa) = 0 Then
  ydxsd = 0
  Else

    sc = InStr(sa, ".")
    If Val(sc) = 0 Then
    ydxsd = sa & String(sd, "0")
    Else
    se = Left(sa, Val(sc) - 1)
    sf = Right(sa, Len(sa) - Val(sc))
    If Val(Len(sf)) >= Val(sd) Then
    ydxsd = se & Mid(sf, 1, sd)
      Else
      ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
      End If
      End If
      End If
      End Function

Private Function fhys(sa As String) As String

If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
End If


End Function
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If


End Function
Private Function jcjs(sa As String) As String

Dim s
s = 1
For I = 1 To sa
s = MbC(Trim(s), Val(I))
Next
jcjs = s


End Function

Private Function qdfh(sa As String) As String

If InStr(sa, "-") > 0 Then
qdfh = Mid(sa, 2)
Else
If InStr(sa, "+") > 0 Then
qdfh = Mid(sa, 2)
Else
qdfh = sa
End If
End If


End Function

Private Function mbbc3(sa As String, sd As String) As String 'kai lifang jingdu daifh
Dim ja
If Val(Len(sa)) = 1 And Trim(sa) = 0 Then
   mbbc3 = 0
   Else

fh = fhys(sa)
ja = MBBC1(qdfh(sa) & String(Val(sd) * 2, "0"))
If InStr(ja, "/") = 0 And Val(fh) > 0 Then
mbbc3 = ja
Else
If InStr(ja, "/") = 0 And Val(fh) < 0 Then
mbbc3 = "-" & ja
Else
If Val(fh) > 0 Then
mbbc3 = Left(ja, InStr(ja, "/") - 1)
Else
mbbc3 = "-" & Left(ja, InStr(ja, "/") - 1)

End If
End If
End If
End If

End Function

第 3 楼

得分:0

'分段传了，下面接续：
Private Function mbbc2(sa As String, sd As String) As String 'kai pingfang jingdu
Dim ja
If Val(Len(sa)) = 1 And Trim(sa) = 0 Then
mbbc2 = 0
Else

ja = MBBC(Trim(sa) & String(Val(sd), "0"))

If InStr(ja, "/") = 0 Then
mbbc2 = ja
Else
mbbc2 = Left(ja, InStr(ja, "/") - 1)
End If
End If

End Function
Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc3 = "-" & jb
Else
If Val(fh2) < 0 Then
mpc3 = "-" & jb
Else
mpc3 = jb
End If
End If
End If
End If

End Function

Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja

End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc2 = "-" & jb
Else
If Val(fh2) <= 0 Then
mpc2 = jb
Else
mpc2 = "-" & jb
End If
End If
End If
End If

End Function
Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else

ja = MBJC(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If

End Function

Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = "0" Or sb = "0" Then
mbc2 = 0
Else

ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If

End Function

Private Function mcc2(sa As String, sb As String, sd As String) As String 'chufa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)

ja = MCC1(qdfh(sa) & String(sd, "0"), qdfh(Trim(sb)))
If InStr(ja, "/") = 0 And Val(fh1) * Val(fh2) > 0 Then
mcc2 = ja
Else
If InStr(ja, "/") = 0 And Val(fh1) * Val(fh2) < 0 Then
mcc2 = "-" & ja
Else
If Val(fh1) * Val(fh2) > 0 Then
mcc2 = Left(ja, InStr(ja, "/") - 1)
Else
mcc2 = "-" & Left(ja, InStr(ja, "/") - 1)
End If
End If
End If

End Function

Public Function MBBC1(D1 As String) As String 'kai lifang
If Len(D1) < 10 Then
jss = Int((D1) ^ (1 / 3))
If (Val(jss) + 1) ^ 3 - Val(D1) = 0 Then
  jss = Val(jss) + 1
  Else
  jss = jss
  End If

JW = Val(D1) - (jss) ^ 3
  If JW = 0 Then
  MBBC1 = jss
  Else
  MBBC1 = jss & "/" & JW
    End If
Else
Dim X 'shuju changdu
X = Len(D1) \ 3
D2 = String(3 - Len(D1) + 3 * X, "0") & D1
Dim A() As String
ReDim A(3 To 3 * X + 3)
Dim B() As String
ReDim B(1 To X)
Dim I, J, js
  For I = 3 To 3 * X + 3 Step 3

A(I) = Mid(D2, I - 2, 3)
Next
js = Int((Val(A(3) & A(6))) ^ (1 / 3))
If (Val(js) + 1) ^ 3 - Val(A(3) & A(6)) = 0 Then
js = Val(js) + 1
Else
js = js
End If

JW = Val(A(3) & A(6)) - (js) ^ 3

   J = 2
   Do While J <= X

   jws = MPC1(JW & "000", A(3 * J + 3))
   If MBJC(Trim(jws), MPC1(MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), 1)), 3), 1)) < 0 Then
    B(J) = "0"
    Else
    jwc = Left(jws, 2) \ Left(MPC1(MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), 1)), 3), 1), 1) '2=Len(jws) - Len(MbC(MbC(Trim(js), MPC1(Trim(js), 1)), 30)) + 1
    If Len(jwc) > 1 Then
     B(J) = 9
     Else
     B(J) = jwc
     End If


     Do While MBJC(Trim(jws), MbC(MPC1(MbC(B(J), B(J)), MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), Trim(B(J)))), 3)), B(J))) = -1

     B(J) = B(J) - 1

               Loop
          End If
          JW = MPC(Trim(jws), MbC(MPC1(MbC(B(J), B(J)), MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), Trim(B(J)))), 3)), B(J)))

     js = MPC1(MbC(Trim(js), 10), Trim(B(J)))


   J = J + 1
   If JW = 0 Then

   MBBC1 = js
   Else
   MBBC1 = js & "/" & JW
   End If
   Loop

End If
End Function

Private Function shuchujg(sa As String, sd As String) As String
'shuchu jieguo
If Len(qqdl(sa)) = 1 And Trim(qqdl(sa)) = 0 Then
shuchujg = 0
Else
sa1 = MPC1(qdfh(Trim(sa)), 49)
fsa = fhys(Trim(sa))
If Len(sa1) = Val(sd) Then
a1 = 0
jb1 = sa1
Else
If Len(sa1) < Val(sd) Then
a1 = 0
jb1 = String(Val(sd) - Len(sa1), "0") & sa1
Else
a1 = Left(sa1, Len(sa1) - Val(sd))
jb1 = Right(sa1, Val(sd))
End If
End If
jb2 = Left(jb1, Val(sd) - 2)
If MBJC(qqdl(Trim(jb2)), 0) = 0 Then
  shuchujg = tjfh(Trim(a1), Val(fsa))
  Else
  shuchujg = tjfh(Trim(a1), Val(fsa)) & "." & jb2
  End If
  End If

End Function

Private Sub Command4_Click()
Label2.Caption = ""
Label3.Caption = ""
Text10.Text = ""

End Sub

Private Sub Command5_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "("
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "("
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "("
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = "("
End If



End Sub

Private Sub Command6_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "√"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "√"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "√"
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = "√"
End If



End Sub

Private Sub Command7_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = ")"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = ")"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = ")"
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = ")"
End If



End Sub

Private Sub Command8_Click()
If sng = 1 Then

Text1.SetFocus
Text1.SelText = "/"
End If
If sng = 2 Then

Text2.SetFocus
Text2.SelText = "/"
End If

If sng = 3 Then

Text3.SetFocus
Text3.SelText = "/"
End If

If sng = 7 Then

Text7.SetFocus
Text7.SelText = "/"
End If



End Sub

Private Sub Command9_Click()
Text11.Text = "1，可以输入含根式和分数的多项式，但3次以上不行" _
& "2，只能有√()和/号，不能有*等其他运算符号，符号不能连用如++，+-，--，" _
& "3，单项式分数的分母不能有√号，  4，单项式分数的分子分母不能再有分数，" _
& "但可以有小数   5，可以有()号但只能有1个，  6，(号左边可以有系数但不能有*号等，最好是数值，" _
& "7，)号右边紧跟/号,且/号右边必须有数字，至少为1不能为0，最好是数值，可以是小数"
Label2.Caption = "提示1"

End Sub

Private Sub Text1_GotFocus()
sng = 1
End Sub

Private Sub Text2_GotFocus()
sng = 2
End Sub
Private Sub Text3_GotFocus()
sng = 3
End Sub

Private Sub Text7_GotFocus()
sng = 7
End Sub

Private Sub Command3_Click()
Text6.Text = Text6.Text & "   1，必须输入数值 " _
& "2，鲍丰武原理，王彦会程序设计 " _
& "3，编制于2013.05.02 " _
& "4，有需要的请与我们联系 " _
& "5，原理见《数学中国》论坛，“风花飘飘”版作品   " _
& "6，输入系数精度要与要求的匹配，如输入0.00000 00000 01（点后12位），要求精度 " _
& "为0.00000 00001（点后10位），不匹配，程序可能会当0处理"
End Sub