Rubrik: Variablen/Strings · Algorithmen/Mathematik | VB-Versionen: VB6 | 30.06.08 |
Arithmetische Ausdrücke auswerten Ein simpler Weg, einfache Terme wie "(1+2)*3" zu lösen | ||
Autor: Arne Elster | Bewertung: | Views: 11.259 |
actorics.de/rm_code | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Dieser Tipp zeigt einen Weg, einfache arithmetische Ausdrücke zu lösen. Dabei geht der Parser von links nach rechts vor und beachtet auch Operatorrangfolgen. Klammerung wird ebenfalls unterstützt.
Ein Bonus dieser Vorgehensweise gegenüber der, das Script Control die Arbeit machen zu lassen, ist natürlich der, dass man eine Komponente weniger mitliefern muss.
Fügen Sie folgenden Code in ein Modul namens MathParser ein:
Option Explicit Private Const TokenUnknown As Long = 0 Private Const TokenOpAdd As Long = 43 Private Const TokenOpSub As Long = 45 Private Const TokenOpMul As Long = 42 Private Const TokenOpDiv As Long = 47 Private Const TokenParLeft As Long = 40 Private Const TokenParRight As Long = 41 Private Const TokenValue As Long = 256 Private Const TokenEnd As Long = 257 Private Type Token TType As Long Value As Double End Type Private m_btInp() As Byte Private m_lngInpLen As Long Private m_lngInpPos As Long Private m_lngParCnt As Long Private m_udtToken As Token
' Parser initialisieren und Ausdruck lösen Public Function MathSolve(ByVal expr As String, _ ByRef result As Double) As Boolean m_btInp = StrConv(expr, vbFromUnicode) m_lngInpLen = UBound(m_btInp) + 1 m_lngInpPos = 0 m_lngParCnt = 0 result = 0 GetNextToken If Expression(result) Then MathSolve = Match(TokenEnd) And (m_lngParCnt = 0) End If End Function
' Expression() löst den gesamten Ausdruck durch Abarbeiten ' von Additionen und Subtraktionen, die die niedrigste Priorität haben ' (Punkt vor Strich) und wird aufgerufen um Ausdrücke in Klammern zu lösen Private Function Expression(ByRef Value As Double) As Boolean Dim dblTerm As Double If Not Term(Value) Then Exit Function Do If Match(TokenOpAdd) Then If Not Term(dblTerm) Then Exit Function Value = Value + dblTerm ElseIf Match(TokenOpSub) Then If Not Term(dblTerm) Then Exit Function Value = Value - dblTerm Else If Match(TokenParRight) Then m_lngParCnt = m_lngParCnt - 1 Exit Do End If Loop Expression = True End Function
' Term() löst Multiplikationen und Divisionen Private Function Term(ByRef Value As Double) As Boolean Dim dblFactor As Double If Not Factor(Value) Then Exit Function Do If Match(TokenOpMul) Then If Not Factor(dblFactor) Then Exit Function Value = Value * dblFactor ElseIf Match(TokenOpDiv) Then If Not Factor(dblFactor) Then Exit Function If dblFactor = 0 Then Exit Function Value = Value / dblFactor Else Exit Do End If Loop Term = True End Function
' Faktor kann eine Zahl oder eine Klammer sein ' Im Fall der Klammer Expression() aufrufen um sie zu lösen Private Function Factor(ByRef dblFactor As Double) As Boolean Dim blnNeg As Boolean blnNeg = Match(TokenOpSub) If Peek(TokenValue) Then dblFactor = m_udtToken.Value GetNextToken Factor = True ElseIf Peek(TokenParLeft) Then GetNextToken m_lngParCnt = m_lngParCnt + 1 Factor = Expression(dblFactor) End If If blnNeg Then dblFactor = -dblFactor End Function
' Typ des aktuellen Tokens prüfen ohne es weiter zu verändern Private Function Peek(ByVal lngType As Long) As Boolean Peek = m_udtToken.TType = lngType End Function
' Stimmt der Typ des aktuellen Tokens überein mit lngType, ' nächstes Token aus dem Stream holen Private Function Match(ByVal lngType As Long) As Boolean If lngType = m_udtToken.TType Then GetNextToken Match = True End If End Function
' Nächstes Token aus Stream holen (Zahl oder Operator) Private Sub GetNextToken() Dim strNum As String Dim blnDot As Boolean m_udtToken.TType = TokenUnknown Do While m_lngInpPos < m_lngInpLen Select Case m_btInp(m_lngInpPos) Case Asc(" ") m_lngInpPos = m_lngInpPos + 1 Case 48 To 57 Do If m_btInp(m_lngInpPos) = 46 Then If blnDot Then Exit Do Else blnDot = True End If End If strNum = strNum & ChrW$(m_btInp(m_lngInpPos)) m_lngInpPos = m_lngInpPos + 1 If m_lngInpPos = m_lngInpLen Then Exit Do Loop While IsNumber(m_btInp(m_lngInpPos)) m_udtToken.TType = TokenValue m_udtToken.Value = Val(strNum) Case Else m_udtToken.TType = m_btInp(m_lngInpPos) m_lngInpPos = m_lngInpPos + 1 End Select If m_udtToken.TType <> TokenUnknown Then Exit Sub Loop m_udtToken.TType = TokenEnd End Sub
Private Function IsNumber(ByVal char As Byte) As Boolean IsNumber = (char >= 48 And char <= 57) Or (char = 46) End Function
Um nun einen Term zu lösen, kann man einfach folgendes Schema verwenden:
Dim dblResult As Double If MathSolve(" ( 1 + 2.5 ) * 3 ", dblResult) Then MsgBox "Ergebnis: " & dblResult Else MsgBox "Fehler im Ausdruck!" End If