用VB评估数学表达式

许多人问是否有一种方法可以写一个数学表达式,在文本框中以字符串形式编写,因此他们可以执行以下操作:

sub something_click()
    textbox2.text=eval(textbox1.text)
end sub
好吧,这当然是可行的,并且可以通过管理某些字符来完成。 这样,您可以根据需要将其复杂化。 我通常的做法是通过5个简单的步骤:

1.创建2个字符串数组,将数字保存在一个中,将运算符保存在另一个中:

2.将第一个数组转换为双精度数组(因此您可以使用Option Strict)

3.评估能力(我不评估根,因为您可以使用a ^ 0.5代替sqrt等)

4.评估产品和部门。

5.评估总和和差额。

完成此小功能后,我想使用递归性制作另一个函数来处理括号,这在处理根时非常有用,因为您可以编写a ^(1/5)而不是第5个根。

让我们将第一个函数称为“ Basics”,然后将括号处理程序称为“ Eval”,它们可能如下所示:

Public Function Basics(ByVal Str1 As String) As Double
        Dim i, j, k As Integer
        Dim Boo1 As Boolean = False
        Dim mStr1(1), mStr2(0), mStr3(0), mStr4(0) As String
        Dim mDou1(), mDou2(), mDou3() As Double 
        If Str1 = "" Then Return 0 : Exit Function
        '----------------------------------------------------------'
        ' Save in mStr1 the numbers. Save in mStr2 the operators.  '
        '----------------------------------------------------------'
        j = 1
        For i = 1 To Str1.Length
            k = Asc(Mid(Str1, i, 1))
            If (k >= Asc("0") And k <= Asc("9")) Or k = Asc(".") Or (k = Asc("-") And Boo1 = False) Then
                mStr1(j) = mStr1(j) & Chr(k): Boo1 = True
            ElseIf k = 69 Then
                mStr1(j) = mStr1(j) & Chr(69) & Mid(Str1, i + 1, 1): i = i + 1
            Else
                If Boo1 = True Then
                    ReDim Preserve mStr2(j)
                    mStr2(j) = Chr(k): j = j + 1
                    ReDim Preserve mStr1(j)
                End If
                Boo1 = False
            End If
        Next
        '--------------------------------------'
        ' Save in mDou1 the numbers as doubles '
        '--------------------------------------'
        ReDim mDou1(UBound(mStr1))
        For i = 1 To UBound(mStr1): mDou1(i) = CDbl(mStr1(i)): Next
        '------------------------'
        ' First priority: powers '
        '------------------------'
        j = 1: ReDim mDou2(1): mDou2(1) = mDou1(1)
        For i = 1 To UBound(mStr2)
            If mStr2(i) = "^" Then: mDou2(j) = mDou2(j) ^ mDou1(i + 1)
            Else
                ReDim Preserve mStr3(j): mStr3(j) = mStr2(i)
                j = j + 1: ReDim Preserve mDou2(j)
                mDou2(j) = mDou1(i + 1)
            End If
        Next
        If UBound(mStr3) = 0 Then Return mDou2(1) : Exit Function
        '-----------------------------------------'
        ' Second priority: products and quotients '
        '-----------------------------------------'
        j = 1: ReDim mDou3(1): mDou3(1) = mDou2(1)
        For i = 1 To UBound(mStr3)
            If mStr3(i) = "*" Then: mDou3(j) = mDou3(j) * mDou2(i + 1)
            ElseIf mStr3(i) = "/" Then: mDou3(j) = mDou3(j) / mDou2(i + 1)
            Else
                ReDim Preserve mStr4(j): mStr4(j) = mStr3(i)
                j = j + 1: ReDim Preserve mDou3(j)
                mDou3(j) = mDou2(i + 1)
            End If
        Next
        If UBound(mStr4) = 0 Then Return mDou3(1) : Exit Function
        '---------------------------------------'
        ' Third priority: sums and differences. '
        '---------------------------------------'
        Basics = mDou3(1)
        For i = 1 To UBound(mStr4)
            If mStr4(i) = "+" Then: Basics = Basics + mDou3(i + 1)
            ElseIf mStr4(i) = "-" Then: Basics = Basics - mDou3(i + 1): End If
        Next
End Function
对于括号处理程序:
Public Function Eval(ByVal Str1 As String) As Double
        Dim i, j, k(2), c As Integer
        Dim Str2 As String
        If Str1 = "" Then Return 0 : Exit Function
        '------------------------------'
        ' Find the outern parenthesis. '
        '------------------------------'
        j = 0
        For i = 1 To Str1.Length
            If Mid(Str1, i, 1) = "(" Then
                If j = 0 Then k(1) = i
                j = j + 1
            ElseIf Mid(Str1, i, 1) = ")" Then
                If j = 1 Then: k(2) = i: Exit For: End If
                j = j - 1
            End If
        Next
        '----------------------------------------------------------------------'
        ' Using recursivity, it'll find the inner ones, and add '*' when needed'
        '----------------------------------------------------------------------'
        If j = 1 Then
            If k(1) > 1 Then c = Asc(Mid(Str1, k(1) - 1, 1))
            Str2 = ""
            If (c >= Asc("0") And c <= Asc("9")) Or c = Asc(".") Then Str2 = "*"
            If c = Asc("-") Then Str2 = "1*"
            Str1 = Eval(Mid(Str1, 1, k(1) - 1) & Str2 & Eval(Mid(Str1, k(1) + 1, k(2) - k(1) - 1)).tostring & Mid(Str1, k(2) + 1).tostring).tostring
        End If
        Return basics(Str1)
End Function
这是VB 2005 Express版本的功能,语法可能会在其他版本的VB中更改,因此您可能必须更改某些“返回”,“ ToString”和“ .Length”,以及使用以下方法声明数组或处理行的方式':'。

您还应注意,当括号之前需要时,它将添加一个“ *”,但之后需要时将不会添加。 所以2(8)= 16但(2)8将是一个错误。

这是一个非常简单的功能,但是我确信您会发现它很有用。

卡德

From: https://bytes.com/topic/visual-basic/insights/759263-evaluate-mathematical-expressions-vb

表达式计算说明 很久就想编一个这样的计算器,只可惜一直没什么思路,最近突然灵感来了,所以就写下 这个程序。现在还在测试阶段,所以功能不是很完善。 程序功能:基本的表达式运算,可以自定义函数跟常量,分别保存在 “常数.txt” 和 “函数.txt”,方便自己添加。双击相应的函数名或常数名就可以将函数或常量添加到表达式中。 计算过程只能当表达式只有一行时有效。 实例1:计算sqr(19+tan(98)*tan(91)-sin(122)*(5*5-(19-11)))/2 计算过程sqr(19+tan(98)*tan(91)-sin(122)*(5*5-(19-11)))/2 =sqr(19+-7.11536972238419*tan(91)-sin(122)*(5*5-(19-11)))/2 =sqr(19+-7.11536972238419*-57.2899616307588-sin(122)*(5*5-(19-11)))/2 =sqr(19+-7.11536972238419*-57.2899616307588-.848048096156426*(5*5-(19-11)))/2 =sqr(19+-7.11536972238419*-57.2899616307588-.848048096156426*(5*5-8))/2 =sqr(19+-7.11536972238419*-57.2899616307588-.848048096156426*17)/2 =20.3032618253667/2 =10.1516309126834 实例2:计算 a=34 b=55 c=a+1 圆的面积(c) a*b c=a+b 圆的面积(c) 以下是计算结果: 圆的面积(c)=3848.4510006475 a*b=1870 圆的面积(c)=24884.5554090847 内置函数: !(x) - x 的阶乘 lg(x),log(x) 以10为底的对数 ln(x) 以 e为底x的对数 pow(x,y) x的y方次幂 prime(x) 判定x是否是素数,如果是直接将s2返回,否则将其各因子用连乘返回 sqr(x),sqrt(x) - x 的二次方根 arcsin(x) - x 的反正弦 arccos(x) - x 的反余弦 arcsec(x) - x 的反正割 arccsc(x) - x 的反余割 atn(x),arctg(x) - x 的反正切 arcctg(x) - x 的反余切 sin(x) - x 的正弦 cos(x) - x 的余弦 sec(x) - x 的正割 csc(x) - x 的余割 tg(x),tan(x) - x 的正切 ctg(x) - x 的余切 harcsin(x) - x 的反双曲正弦 harccos(x) - x 的反双曲余弦 harcsec(x) - x 的反双曲正割 harccsc(x) - x 的反双曲余割 harctg(x),harctan(x) - x 的反双曲正切 harcctg(x) - x 的反双曲余切 hsin(x) - x 的双曲正弦 hcos(x) - x 的双曲余弦 hsec(x) - x 的双曲正割 hcsc(x) - x 的双曲余割 htg(x),htan(x) - x 的双曲正切 hctg(x) - x 的双曲余切 有什么意见或建议可以跟我联系Email: ldm.menglv@gmail.com
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值