堆栈计算器

'堆栈计算器，支持+ - * / ^ 和 三角函数 以及对数的运算，扩展也很方便。感谢作者发布！
'作者：wssccc
'QQ:151884336

Dim OV[color=#0000ff](500)
Dim OP(500)
Dim Adv(500)
Dim Ops, Ovs, K As Integer
Dim isEmpty As Boolean

Function Process(Formula As String)
    ClearAll

    Formula = Formula & ";"

    Dim P, str, o
    P = 1

    Do While (P < Len(Formula))

        If IsNumeric(Mid$(Formula, P, 1)) Then
            str = ""
            Do While ((IsNumeric(Mid$(Formula, P, 1))) or Mid$(Formula, P, 1) = ".") And (P < Len(Formula))

                str = str & Mid$(Formula, P, 1)
                P = P + 1
            Loop

            PushNum str

        Else

            str = ""
            Do While GetAdv(str) = -1 And (P < Len(Formula))

                str = str & Mid$(Formula, P, 1)
                P = P + 1
            Loop

            Do

                If GetAdv(str) > Adv(Ops) or isEmpty = True Then
                    If GetAdv(str) <> 1000 Then PushOP str
                    Exit Do
                Else
                    Calc

                End If

            Loop
        End If

    Loop

    Do While isEmpty = False
        Calc
    Loop

    Process = PopNum
    ClearAll

End Function

Sub PushNum(Num)
    Ovs = Ovs + 1
    OV(Ovs) = Num
End Sub

Function PopNum() As Double
    PopNum = OV(Ovs)
    Ovs = Ovs - 1

End Function


Sub PushOP(Oper)
    Ops = Ops + 1
    OP(Ops) = Oper
    Adv(Ops) = GetAdv(Oper)
    isEmpty = False
End Sub

Function PopOP()
    PopOP = OP(Ops)
    Ops = Ops - 1

    If Ops <= 0 Then
        isEmpty = True
    Else
        isEmpty = False
    End If

End Function


Function GetAdv(str) As Integer
    Select Case str
        Case ";"
        GetAdv = 0 + K
        Case "+"
        GetAdv = 1 + K
        Case "-"
        GetAdv = 1 + K
        Case "*"
        GetAdv = 2 + K
        Case "/"
        GetAdv = 2 + K
        Case "sin"
        GetAdv = 3 + K
        Case "cos"
        GetAdv = 3 + K
        Case "tan"
        GetAdv = 3 + K
        Case "log"
        GetAdv = 3 + K
        Case "^"
        GetAdv = 3 + K
        Case "("
        GetAdv = 1000
        K = K + 10
        Case ")"
        GetAdv = 1000
        K = K - 10

        Case Else
        GetAdv = -1
    End Select
End Function

Sub Calc()

    Dim o
    o = PopOP
    Select Case o

        Case "+"
        PushNum (PopNum + PopNum)
        Case "-"
        PushNum (0 - PopNum + PopNum)
        Case "*"
        PushNum (PopNum * PopNum)
        Case "/"
        PushNum (1 / PopNum * PopNum)
        Case "sin"
        PushNum Sin(PopNum)
        Case "cos"
        PushNum Cos(PopNum)
        Case "tan"
        PushNum Tan(PopNum)
        Case "log"
        PushNum Log(PopNum)
        Case "^"
        Dim a, b
        a = PopNum
        b = PopNum
        PushNum (b ^ a)

    End Select

End Sub

Sub ClearAll()

    'Dim OV(500)
    'Dim OP(500)
    'Dim Adv(500)
    'Dim Ops, Ovs, K As Integer
    'Dim isEmpty As Boolean
    '

    Dim i
    For i = 0 To 500
        OV(i) = 0
        OP(i) = 0
        Adv(i) = 0
    Next

    Ops = 0
    Ovs = 0
    K = 0

    isEmpty = True
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim P, cP
cP = Text1.SelStart + 1

If KeyAscii = 13 Then
    
Do While cP < Len(Text1.Text)
       If Asc(Mid(Text1.Text, cP, 1)) = 13 Then Exit Do
    cP = cP + 1
Loop

    P = cP - 1
    Do While P > 0
        If Asc(Mid(Text1.Text, P, 1)) = 10 Then Exit Do
    P = P - 1
     Loop
    
     Text1.Text = Text1.Text & vbCrLf & Process(Mid(Text1.Text, P + 1, cP - P))
     Text1.SelStart = Len(Text1.Text)
    
End If

End Sub