解四次方程的代码

ysr

解四次方程的代码如下：


Private Sub Command1_Click()
Dim a, b, c, d, f, g
Dim ja, jb, jc
k = DeleteSpace(Text1.Text)
ja = DeleteSpace(Text2.Text)
jb = DeleteSpace(Text3.Text)
jc = DeleteSpace(Text4.Text)
jd = DeleteSpace(Text5.Text)
sd1 = DeleteSpace(Text15.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))
D2 = zhengliys2(Trim(jd), Val(sd))
k2 = zhengliys2(Trim(k), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
Text4.Text = "a 不能为 0"
   Text5.Text = "a 为 0可能已不是1元4次方程"
  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))
d3 = mcc2(Trim(D2), Trim(k2), Val(sd))
jk = 8 & String(sd, "0")
ja1 = mbc2("-4" & String(sd, "0"), Trim(b3), Val(sd))
jb1 = mpc2(mbc2(2 & String(sd, "0"), mbc2(Trim(a3), Trim(c3), Val(sd)), Val(sd)), mbc2(8 & String(sd, "0"), Trim(d3), Val(sd)))
jc1 = mpc2(mbc2(Trim(d3), mpc2(mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), Val(sd)), mbc2(Trim(c3), Trim(c3), Val(sd)))
y = jie3cifc(Trim(ja1), Trim(jb1), Trim(jc1), Trim(jk), Val(sd))
Y1 = zhengliys2(Trim(y), Val(sd))
End If
Text6 = zhengliys2(Trim(y), Val(sd))
Text8 = y
za = 1 & String(sd, "0")
z2 = mpc2(mpc3(mbc2(8 & String(sd, "0"), Trim(Y1), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)))
z2 = mbbc2(qdfh(Trim(z2)), Val(sd))

zb1 = mcc2(mpc3(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zb2 = mcc2(mpc2(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zc1 = mpc3(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
zc2 = mpc2(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
y3 = jie2cifc(Trim(za), Trim(zb1), Trim(zc1), Val(sd))
y4 = jie2cifc(Trim(za), Trim(zb2), Trim(zc2), Val(sd))
Text9 = y3
Text10 = y4

Text14.Text = Text14.Text & "  输入" & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & "，e=" & jd & ";  输出结果" & ":    " & "x1,2=" & Text9.Text & ",  x3,4=" & Text10.Text
End Sub

ysr

输入1:  a=1,  b=2,  c=-3,  d=4，e=5;  输出结果1:    x1,2=-1.9556023509+ -1.2268754722,  x3,4=0.9556023509+ -1.1148003552i
'解四次方程的代码如下（这个运行结果是对的）:
Private Sub Command1_Click()
Dim a, b, c, d, f, g
Dim ja, jb, jc
k = DeleteSpace(Text1.Text)
ja = DeleteSpace(Text2.Text)
jb = DeleteSpace(Text3.Text)
jc = DeleteSpace(Text4.Text)
jd = DeleteSpace(Text5.Text)
sd1 = DeleteSpace(Text15.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))
D2 = zhengliys2(Trim(jd), Val(sd))
k2 = zhengliys2(Trim(k), Val(sd))
If MBJC(Trim(k2), 0) = 0 Then
Text4.Text = "a 不能为 0"
   Text5.Text = "a 为 0可能已不是1元4次方程"
  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))
d3 = mcc2(Trim(D2), Trim(k2), Val(sd))
jk = 8 & String(sd, "0")
ja1 = mbc2("-4" & String(sd, "0"), Trim(b3), Val(sd))
jb1 = mpc2(mbc2(2 & String(sd, "0"), mbc2(Trim(a3), Trim(c3), Val(sd)), Val(sd)), mbc2(8 & String(sd, "0"), Trim(d3), Val(sd)))
jc1 = mpc2(mbc2(Trim(d3), mpc2(mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), Val(sd)), mbc2(Trim(c3), Trim(c3), Val(sd)))
Y = jie3cifc(Trim(ja1), Trim(jb1), Trim(jc1), Trim(jk), Val(sd))
Y1 = zhengliys2(Trim(Y), Val(sd))
End If
Text6 = zhengliys2(Trim(Y), Val(sd))
Text8 = Y
za = 1 & String(sd, "0")
z2 = mpc2(mpc3(mbc2(8 & String(sd, "0"), Trim(Y1), Val(sd)), mbc2(Trim(a3), Trim(a3), Val(sd))), mbc2(4 & String(sd, "0"), Trim(b3), Val(sd)))
z2 = mbbc2(qdfh(Trim(z2)), Val(sd))

zb1 = mcc2(mpc3(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zb2 = mcc2(mpc2(Trim(a3), Trim(z2)), 2 & String(sd, "0"), Val(sd))
zc1 = mpc3(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
zc2 = mpc2(Trim(Y1), mcc2(mpc2(mbc2(Trim(a3), Trim(Y1), Val(sd)), Trim(c3)), Trim(z2), Val(sd)))
y3 = jie2cifc(Trim(za), Trim(zb1), Trim(zc1), Val(sd))
y4 = jie2cifc(Trim(za), Trim(zb2), Trim(zc2), Val(sd))
Text9 = y3
Text10 = y4

Text15.Text = Text14.Text & "  输入" & ":  " & "a=" & k & ",  b=" & ja & ",  c=" & jb & ",  d=" & jc _
  & "，e=" & jd & ";  输出结果" & ":    " & "x1,2=" & Text9.Text & ",  x3,4=" & Text10.Text
End Sub

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 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