calc.bas

VB6 Consol Window Demo

        g = Sin(G2(Exppression, Good, position, xxx))
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "COS", position) Then
        position = position + 3
        Call PassBlank(Exppression, position)
        g = Cos(G2(Exppression, Good, position, xxx))
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "TAN", position) Then
        position = position + 3
        Call PassBlank(Exppression, position)
        g = Tan(G2(Exppression, Good, position, xxx))
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "LOG", position) Then
        position = position + 3
        Call PassBlank(Exppression, position)
        g = Log(G2(Exppression, Good, position, xxx)) / Log(10#)
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "LN", position) Then
        position = position + 2
        Call PassBlank(Exppression, position)
        g = Log(G2(Exppression, Good, position, xxx))
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "EXP", position) Then
        position = position + 3
        Call PassBlank(Exppression, position)
        g = Exp(G2(Exppression, Good, position, xxx))
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "ARCTAN", position) Then
        position = position + 6
        Call PassBlank(Exppression, position)
        g = Atn(G2(Exppression, Good, position, xxx))
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "ARCSIN", position) Then
        position = position + 6
        Call PassBlank(Exppression, position)
        tmp1 = G2(Exppression, Good, position, xxx)
        If tmp1 <> 1 And tmp1 <> -1 Then
            g = Atn(tmp1 / Sqr(1 - tmp1 * tmp1))
        Else
            If tmp1 = 1 Then g = pi / 2 Else g = -pi / 2
        End If
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "ARCCOS", position) Then
        position = position + 6
        Call PassBlank(Exppression, position)
        tmp1 = G2(Exppression, Good, position, xxx)
        If tmp1 <> 1 And tmp1 <> -1 Then
            g = Atn(-tmp1 / Sqr(1 - tmp1 * tmp1)) + pi / 2
        Else
            If tmp1 = 1 Then g = 0# Else g = pi
        End If
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "POW", position) Then
        position = position + 3
        Call PassBlank(Exppression, position)
        If Match(Exppression, "(", position) Then
            position = position + 1
            tmp1 = E(Exppression, isg, position, xxx)
            If Match(Exppression, ",", position) And isg Then
                position = position + 1
                tmp2 = E(Exppression, isg, position, xxx)
                If Match(Exppression, ")", position) And isg Then
                    position = position + 1
                    Call PassBlank(Exppression, position)
                    Good = True
                    g = tmp1 ^ tmp2
                    Exit Function
                End If
            End If
        End If
        Good = False
        Exit Function
    End If
    g = G2(Exppression, Good, position, xxx)
    Call PassBlank(Exppression, position)
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 函数名称：G2
'+----+----+--- 参数：ByVal 为pression As String型
'+----+----+--- 参数：ByRef 为d As Boolean型
'+----+----+--- 参数：ByRef 为ition As Integer型
'+----+----+--- 参数：ByVal 为 As Double型
'As Double'+----+----+--- 返回类型：As Double
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Function G2(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
    Dim tmp As Double
    Dim isg As Boolean
    If Match(Exppression, "(", position) Then
        position = position + 1
        Call PassBlank(Exppression, position)
        tmp = E(Exppression, isg, position, xxx)
        If isg And Match(Exppression, ")", position) Then
            G2 = tmp
            position = position + 1
            Good = True
        Else
            Good = False
        End If
    End If
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 函数名称：NonopDigital
'+----+----+--- 参数：ByVal 为pression As String型
'+----+----+--- 参数：ByRef 为d As Boolean型
'+----+----+--- 参数：ByRef 为ition As Integer型
'+----+----+--- 参数：ByVal 为 As Double型
'As Double'+----+----+--- 返回类型：As Double
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Function NonopDigital(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
    Dim tmp1 As Double
    Dim tmp2 As Double
    Dim tmpStr As String
    Call PassBlank(Exppression, position)
    If Match(Exppression, "X", position) Then
        NonopDigital = xxx
        Good = True
        position = position + 1
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    tmp1 = 0
    tmp2 = 0
    tmpStr = Mid$(Exppression, position, 1)
    If tmpStr >= "0" And tmpStr <= "9" Then
        While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
        tmp2 = tmp2 + 1
        tmpStr = Mid$(Exppression, position + tmp2, 1)
        Wend
        If tmpStr = "." Then tmp2 = tmp2 + 1
        tmpStr = Mid$(Exppression, position + tmp2, 1)
        While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
        tmp2 = tmp2 + 1
        tmpStr = Mid$(Exppression, position + tmp2, 1)
        Wend
        If tmpStr = "E" Then tmp2 = tmp2 + 1
        tmpStr = Mid$(Exppression, position + tmp2, 1)
        While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
        tmp2 = tmp2 + 1
        tmpStr = Mid$(Exppression, position + tmp2, 1)
        Wend
        tmp1 = Val(Mid$(Exppression, position))
        position = position + tmp2
        Good = True
    Else
        Good = False
    End If
    NonopDigital = tmp1
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 函数名称：OpDigital
'+----+----+--- 参数：ByVal 为pression As String型
'+----+----+--- 参数：ByRef 为d As Boolean型
'+----+----+--- 参数：ByRef 为ition As Integer型
'+----+----+--- 参数：ByVal 为 As Double型
'As Double'+----+----+--- 返回类型：As Double
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Function OpDigital(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
    Dim tmp As Double
    Dim isg As Boolean
    Dim sign As Integer
    sign = 1
    Call PassBlank(Exppression, position)
    If Match(Exppression, "X", position) Then
        OpDigital = xxx
        Good = True
        position = position + 1
        Call PassBlank(Exppression, position)
        Exit Function
    End If
    If Match(Exppression, "-", position) Then
        position = position + 1
        sign = -1
    Else
        If Match(Exppression, "+", position) Or Mid$(Exppression, position, 1) >= "0" And Mid$(Exppression, position, 1) <= "9" Then
            sign = 1
        Else
            Good = False
            Exit Function
        End If
    End If
    tmp = F2(Exppression, isg, position, xxx)
    If Not (isg) Then Good = False Else Good = True
    OpDigital = tmp * sign
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 函数名称：Match
'+----+----+--- 参数：ByVal 为pression As String型
'+----+----+--- 参数：ByVal 为pression2 As String型
'+----+----+--- 参数：ByRef 为ition As Integer型
'As Boolean'+----+----+--- 返回类型：As Boolean
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Function Match(ByVal Exppression As String, ByVal Exppression2 As String, ByRef position As Integer) As Boolean
    If Mid$(Exppression, position, Len(Exppression2)) = Exppression2 Then Match = True Else Match = False
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：PassBlank
'+----+----+--- 参数：ByVal 为pression As String型
'+----+----+--- 参数：ByRef 为ition As Integer型
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub PassBlank(ByVal Exppression As String, ByRef position As Integer)
    While Mid$(Exppression, position, 1) = " "
    position = position + 1
    Wend
End Sub