form1.vb

vb2005编写的计算器。 直接输入字符串

Public Class Form1
    Dim strErr As String
    Dim blErr As Boolean = False
    Private Function Calc(ByVal strCalc As String) As String
        Dim left_num As Integer = 0
        Dim right_num As Integer = 0
        Dim i As Integer
        Dim go_on As Boolean = True
        Dim left_len As Integer = 0
        Dim right_len As Integer = 0
        Dim chrCalc As Char
        For i = 1 To strCalc.Length()
            chrCalc = Mid(strCalc, i, 1)
            If chrCalc = "(" Then
                left_num += 1
            ElseIf chrCalc = ")" Then
                right_num += 1
            End If
        Next
        If (right_num = 0 And left_num = 0) Then

            Return calc_num(strCalc)
        ElseIf (left_num <> right_num) Then
            blErr = True
            strErr = "左右括号数不等!"
            Return "error"
        End If
        i = 1 : left_num = 0 : right_num = 0
        While (go_on)
            chrCalc = Mid(strCalc, i, 1)
            If chrCalc = "(" Then
                If left_num = 0 Then
                    left_len = i
                End If
                left_num += 1
            ElseIf chrCalc = ")" Then
                right_num += 1 : right_len = i
            End If
            If (right_num > left_num) Then
                blErr = True
                strErr = "左右括号不匹配!"
                Return "error"
            End If
            If (right_num > 0 And right_num = left_num) Then

                Dim left_str As String = Microsoft.VisualBasic.Left(strCalc, (left_len - 1))
                Dim right_str As String = Microsoft.VisualBasic.Right(strCalc, strCalc.Length() - i)
                Dim new_calc As String = Mid(strCalc, (left_len + 1), (right_len - left_len - 1))
                Return Calc(left_str & Calc(new_calc) & right_str)
            End If
            i += 1
            If i = strCalc.Length() + 1 Then
                go_on = False
            End If
        End While
    End Function
    Private Function Calc_num(ByVal strCalc As String) As String
        Dim i As Integer = 1
        Dim op_i As Integer = 0
        Dim go_on As Boolean = True
        Dim op_sign(4) As Char
        Dim op_yx() As Byte = {0, 0, 0, 0, 0}
        ReDim Preserve op_yx(4)
        Dim op_len(4) As Integer
        Dim op As Char, op_left As Integer, op_right As Integer
        Dim op_num1 As Double
        Dim op_num2 As Double
        While (go_on)
            Dim tmpChr As Char = Mid(strCalc, i, 1)
            Select Case tmpChr
                Case "S", "C", "T", "t", "c", "a", "b", "f", "L", "l", "s"
                    op_sign(op_i) = tmpChr
                    op_len(op_i) = i
                    op_yx(op_i) = 4
                    op_i += 1
                Case "-"
                    If i > 1 Then
                        Dim tmpChr2 As Byte = Asc(Mid(strCalc, i - 1, 1))
                        If ((tmpChr2 = 46) Or (tmpChr2 < 58 And tmpChr2 > 47)) Then
                            op_sign(op_i) = tmpChr
                            op_len(op_i) = i
                            op_yx(op_i) = 1
                            op_i += 1
                        End If
                    End If


                Case "+"
                    Dim tmpChr2 As Char = Mid(strCalc, i - 1, 1)
                    If tmpChr2 <> "E" Then
                        op_sign(op_i) = tmpChr
                        op_len(op_i) = i
                        op_yx(op_i) = 1
                        op_i += 1
                    End If
                Case "*", "/", "\"
                    op_sign(op_i) = tmpChr
                    op_len(op_i) = i
                    op_yx(op_i) = 2
                    op_i += 1
                Case "^"
                    op_sign(op_i) = tmpChr
                    op_len(op_i) = i
                    op_yx(op_i) = 3
                    op_i += 1
            End Select
            i += 1
            If (op_i = 4 Or i > strCalc.Length()) Then
                go_on = False
            End If
        End While
        If op_yx(0) = 0 Then
            Return strCalc
        End If
        If op_yx(1) <= op_yx(0) Then
            op_left = 0
            op_right = op_len(1)
            op_num1 = Val(Microsoft.VisualBasic.Left(strCalc, (op_len(0) - 1)))
            If op_len(1) <> 0 Then
                op_num2 = Val(Mid(strCalc, op_len(0) + 1, op_len(1) - op_len(0) - 1))
            Else
                op_right = strCalc.Length() + 1
                op_num2 = Val(Microsoft.VisualBasic.Right(strCalc, strCalc.Length() - op_len(0)))
            End If

            op = op_sign(0)
        Else
            If op_yx(2) <= op_yx(1) Then
                op_left = op_len(0)
                op_right = op_len(2)
                op_num1 = Val(Mid(strCalc, op_len(0) + 1, op_len(1) - op_len(0) - 1))
                If op_len(2) <> 0 Then
                    op_num2 = Val(Mid(strCalc, op_len(1) + 1, op_len(2) - op_len(1) - 1))
                Else
                    op_num2 = Val(Microsoft.VisualBasic.Right(strCalc, strCalc.Length() - op_len(1)))
                    op_right = strCalc.Length() + 1
                End If

                op = op_sign(1)
            Else
                If op_yx(3) <= op_yx(2) Then
                    op_num1 = Val(Mid(strCalc, op_len(1) + 1, op_len(2) - op_len(1) - 1))
                    op_left = op_len(1)
                    op_right = op_len(3)
                    If op_len(3) <> 0 Then
                        op_num2 = Val(Mid(strCalc, op_len(2) + 1, op_len(3) - op_len(2) - 1))
                    Else
                        op_right = strCalc.Length() + 1
                        op_num2 = Val(Microsoft.VisualBasic.Right(strCalc, strCalc.Length() - op_len(2)))
                    End If

                    op = op_sign(2)
                Else
                    op_num1 = Val(Mid(strCalc, op_len(2) + 1, op_len(3) - op_len(2) - 1))
                    op_left = op_len(2)
                    op_right = op_len(4)
                    If op_len(4) <> 0 Then
                        op_num2 = Val(Mid(strCalc, op_len(3) + 1, op_len(4) - op_len(3) - 1))
                    Else
                        op_right = strCalc.Length() + 1
                        op_num2 = Val(Microsoft.VisualBasic.Right(strCalc, strCalc.Length() - op_len(3)))
                    End If

                    op = op_sign(3)
                End If
            End If
        End If
        Dim tmpNum As Double
        Select Case op
            Case "+"
                tmpNum = op_num1 + op_num2
            Case "-"
                tmpNum = op_num1 - op_num2
            Case "*"
                tmpNum = op_num1 * op_num2
            Case "/", "\"
                If op_num2 <> 0 Then
                    tmpNum = op_num1 / op_num2
                Else
                    blErr = True
                    strErr = "除数不能为零!"
                End If

            Case "^"
                tmpNum = System.Math.Pow(op_num1, op_num2)
                If Double.IsNaN(tmpNum) = True Then
                    blErr = True
                    strErr = "开方出错，可能结果为虚数！"
                End If
            Case "S"
                tmpNum = Math.Sin(op_num2)
            Case "C"
                tmpNum = Math.Cos(op_num2)
            Case "T"
                tmpNum = Math.Tan(op_num2)
            Case "t"
                tmpNum = Math.Tanh(op_num2)
            Case "s"
                tmpNum = Math.Sinh(op_num2)
            Case "c"
                tmpNum = Math.Cosh(op_num2)
            Case "L"
                tmpNum = Math.Log(op_num2)
                If Double.IsNaN(tmpNum) = True Then
                    blErr = True
                    strErr = "对数函数定义域出错！"
                End If
            Case "l"
                tmpNum = Math.Log10(op_num2)
                If Double.IsNaN(tmpNum) = True Then
                    blErr = True
                    strErr = "对数函数定义域出错！"
                End If
            Case "a"
                tmpNum = Math.Asin(op_num2)
                If Double.IsNaN(tmpNum) = True Then
                    blErr = True
                    strErr = "反正弦函数定义域出错！"
                End If
            Case "b"
                tmpNum = Math.Acos(op_num2)
            Case "f"
                tmpNum = Math.Atan(op_num2)
                If Double.IsNaN(tmpNum) = True Then
                    blErr = True
                    strErr = "反余弦函数定义域出错！"
                End If
        End Select

        Dim new_calc As String = Microsoft.VisualBasic.Left(strCalc, op_left) & Microsoft.VisualBasic.Str(tmpNum) & Microsoft.VisualBasic.Right(strCalc, strCalc.Length() - op_right + 1)

        Return calc_num(new_calc)
    End Function
    Private Function Convert(ByVal rtnStr As String) As String
        Dim i As Integer
        Dim go_on As Boolean = True
        Dim tmpStr As String
        For j As Short = 4 To 1 Step -1
            i = 1
            go_on = True
            While (go_on)
                tmpStr = Mid(rtnStr, i, j)
                Dim t As String = tmpStr.ToLower

                Select Case t
                    Case "sin"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "S" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)
                    Case "cos"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "C" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)
                    Case "tan"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "T" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)
                    Case "sinh"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "s" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "cosh"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "c" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "tanh"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "t" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "asin"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "a" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "acos"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "b" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "atan"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "f" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "ln"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "L" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "log"
                        rtnStr = Strings.Left(rtnStr, i - 1) & "l" & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)

                    Case "pi"
                        rtnStr = Strings.Left(rtnStr, i - 1) & Math.PI.ToString & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)
                        i += 17
                    Case "e"
                        If tmpStr <> "E" Then
                            rtnStr = Strings.Left(rtnStr, i - 1) & Math.E.ToString & Strings.Right(rtnStr, rtnStr.Length() - i - j + 1)
                            i += 17
                        End If
                End Select
                i += 1
                If (i >= rtnStr.Length() - j + 2) Then
                    go_on = False
                End If

            End While
        Next j
        Return rtnStr

    End Function
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If TextBox1.Text = "" Then
            Exit Sub
        End If
        Dim cnvStr As String = Convert(TextBox1.Text)
        Label1.Text = cnvStr
        Dim ans As String
        Dim t As Double
        t = System.DateTime.Now.Millisecond
        ans = Calc(cnvStr)
        t = System.DateTime.Now.Millisecond - t
        If blErr = True Then
            ans = ""
            TextBox2.Text = strErr
            blErr = False
        Else
            TextBox2.Text = ans
            Label1.Text = "本次计算用时：" & t & "毫秒"
        End If
    End Sub

    Private Sub TextBox1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown
        If e.KeyCode = Keys.Enter Then
            Button1.PerformClick()
        End If
    End Sub




    Private Sub TextBox1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
        Select Case e.KeyChar
            Case "-" To "9", "(" To "+", "^", "S", "s", "C", "c", "o", "i", "n", "l", "g", "a", "T", "t", "A", "e", "P", "p", "E", ChrW(Keys.Back), ChrW(Keys.Enter)
                Exit Sub
        End Select
        e.KeyChar = ""
    End Sub

    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        MsgBox(Calc_num("1.0E+100"))
    End Sub
End Class