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 Dieser Tipp wurde bereits 11.287 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |