Tipp-Upload: VB.NET 0034: Funktionswert-Rechner

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Mathematik
• Sonstiges

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Funktionswert, taschenrechner, rechner,VBCodeProvider,CodeProvider

Der Vorschlag wurde erstellt am: 04.09.2007 08:35.
Die letzte Aktualisierung erfolgte am 09.04.2011 11:44.

Zurück zur Übersicht

Beschreibung  

Für diesen "Taschenrechner" machen wir es uns einfach:
Wir generieren einen String, der VB-Code enthält, mit einer Funktion, in die der f(x)-Ausdruck eingebettet wird. Das ganze kompiliert uns ein VBCodeProvider, sodaß wir im Speicher eine Assembly erhalten, die uns Funktionswerte ausrechnen kann.
Siehe auch  VB.NET Tipp 33, und natürlich MSDN

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [15,68 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ----------- Anfang Projektgruppe Calculator.sln  -----------
' ---------- Anfang Projektdatei Calculator.vbproj  ----------
' ---------------- Anfang Datei Calculator.vb ----------------
' Projekteinstellungen:
' Option Strict On
' Option Explicit On
' Imports Microsoft.VisualBasic.ControlChars

Imports System.Reflection
Imports System.CodeDom.Compiler
Imports System.Text.RegularExpressions

Public Class Calculator

    Implements IDisposable

    Private _prov As New Microsoft.VisualBasic.VBCodeProvider
    Private _tpClass1 As Type

    Private Shared ReadOnly _bindFlags As BindingFlags = BindingFlags.DeclaredOnly Or _
        BindingFlags.Public Or BindingFlags.InvokeMethod Or BindingFlags.Static

    ' mit diesem Regex wird bei mathematische Multiplikation-Schreibweise das im VB-Code
    ' erforderliche '*' eingefügt
    Private _rgx As New Regex("(?<=\d)\s*\*?\s*(?=[a-zA-Z\(])", RegexOptions.Compiled)

    Public Function TrySetExpression(ByVal Value As String) As Boolean

        Static expression As String

        If Not AssignSave(expression, _rgx.Replace(Value, "*")) Then Return _tpClass1 IsNot Nothing
        _tpClass1 = Nothing

        Dim sl As New StringList

        ' vollständige kleine Klasse mit einer Function
        sl.AddLine("Imports System.Math")
        sl.AddLine("Public Class Class1")
        sl.AddLine("Public Shared Function Calc(ByVal X As Double) As Object")
        sl.AddLine("Return ", expression) ' expression, vom User eingegeben, wird einkompiliert
        sl.AddLine("End Function")
        sl.AddLine("End Class")

        Dim cp As New CompilerParameters

        cp.GenerateInMemory = True

        Dim cr As CompilerResults = _prov.CompileAssemblyFromSource(cp, sl.Flush)

        If cr.Errors.Count > 0 Then
            sl.AddLines("Die Expression konnte nicht kompiliert werden.", "")

            For Each err As CompilerError In cr.Errors
                sl.AddLine(err.ErrorText)
            Next

            MsgBox(sl.Flush)
            Return False
        End If

        ' aus der Assembly interessiert nur der Reflection-Type "Class1"
        _tpClass1 = cr.CompiledAssembly().GetType("Class1")
        Return True

    End Function

    Public Function Calc(ByVal x As Double) As Single

        ' "gerechnet" wird, indem die Class1.Calc()-Function per Reflection aufgerufen wird
        Dim args() As Object = {x}

        Return CSng(_tpClass1.InvokeMember("Calc", _bindFlags, Nothing, Nothing, args, Nothing))

    End Function

    Public Sub Dispose() Implements IDisposable.Dispose

        If _prov Is Nothing Then Return
        _prov.Dispose()
        _prov = Nothing
        GC.SuppressFinalize(Me)

    End Sub

End Class

' ----------------- Ende Datei Calculator.vb -----------------
' -------------- Anfang Datei frmCalculator.vb  --------------
Public Class frmCalculator

    Private _calculator As New Calculator

    Private Shared _culture As Globalization.CultureInfo = _
        Globalization.CultureInfo.InvariantCulture

    Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click

        If _calculator.TrySetExpression(Me.txtFunction.Text) Then

            Dim x As Double

            If Double.TryParse(txtXValue.Text, Globalization.NumberStyles.Float, _culture, x) Then
                Me.lbResult.Text = _calculator.Calc(x).ToString(_culture)
                Me.ErrorProvider1.Clear()
                My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Asterisk)

            Else

                Dim err As String = "Ungültige Eingabe"

                If txtXValue.Text.Contains(",") Then
                    err &= NewLine & "(Dezimaltrenner ist ""."")"
                End If

                Me.ErrorProvider1.SetError(txtXValue, err)
            End If
        End If

    End Sub

    Private Sub frmCalculator_Disposed(ByVal sender As Object, ByVal e As EventArgs) Handles _
        Me.Disposed

        _calculator.Dispose()

    End Sub

End Class

' --------------- Ende Datei frmCalculator.vb  ---------------
' ---------------- Anfang Datei modHelpers.vb ----------------
Public Module modHelpers

    ''' <summary>
    ''' testet vor einer Zuweisung, ob der neue Wert überhaupt
    ''' eine Änderung bringt
    ''' </summary>
    ''' <remarks>
    ''' nützlich bei Zuweisungen an performance-intensive Properties, 
    ''' oder wenn auf Änderungen reagiert werden muß
    ''' </remarks>
    Public Function AssignSave(Of T)(ByRef dest As T, ByVal src As T) As Boolean

        If Object.Equals(dest, src) Then Return False
        dest = src
        Return True

    End Function

End Module

' ----------------- Ende Datei modHelpers.vb -----------------
' ---------------- Anfang Datei Stringlist.vb ----------------
Imports System.Collections
Imports System.Text

Public Class StringList

    Inherits System.Collections.Generic.List(Of Object)

    ' Vereinfacht das Zusammenstöpseln längerer Texte. Im Unterschied zum StringBuilder
    ' werden die Objekte nicht gleich nach String umgewandelt, sondern erst beim Abruf von
    ' ToString(), wobei dann noch einstellbar ist, was als "Wort"-Trenner, und was als
    ' Zeilentrenner verwendet werden soll.

    Private Shared ReadOnly _newLineID As New Object()
    Private _delimiter, _newLine As String

    Public Sub New(Optional ByVal _delimiter As String = " ", _
              Optional ByVal _NewLine As String = Microsoft.VisualBasic.ControlChars.NewLine)

        Me._delimiter = _delimiter
        Me._newLine = _NewLine

    End Sub

    Public Shadows Function Add(ByVal ParamArray args As Object()) As StringList

        MyBase.AddRange(args)
        Return Me

    End Function

    Public Function AddLine(ByVal line As String) As StringList

        MyBase.Add(line)
        MyBase.Add(_newLineID)
        Return Me

    End Function

    Public Function AddLine(ByVal ParamArray args As Object()) As StringList

        MyBase.AddRange(args)
        MyBase.Add(_newLineID)
        Return Me

    End Function

    Public Function AddLine(ByVal args As IEnumerable) As StringList

        For Each arg As Object In args
            MyBase.Add(arg)
        Next

        MyBase.Add(_newLineID)
        Return Me

    End Function

    Public Function AddLines(ByVal line As String) As StringList

        MyBase.Add(line)
        MyBase.Add(_newLineID)
        Return Me

    End Function

    Public Function AddLines(ByVal ParamArray args As Object()) As StringList

        For Each arg As Object In args
            MyBase.Add(arg)
            MyBase.Add(_newLineID)
        Next

        Return Me

    End Function

    Public Function AddLines(ByVal args As IEnumerable) As StringList

        For Each arg As Object In args
            MyBase.Add(arg)
            MyBase.Add(_newLineID)
        Next

        Return Me

    End Function

    Public Overloads Function ToString(Optional ByVal delimiter As String = Nothing, Optional _
        ByVal newLine As String = Nothing) As String

        If delimiter Is Nothing Then delimiter = _delimiter
        If newLine Is Nothing Then newLine = _newLine

        Dim sb As New StringBuilder(MyBase.Count * 12)
        Dim lineStart As Boolean = True

        For Each item As Object In Me

            If Object.ReferenceEquals(item, _newLineID) Then
                sb.Append(newLine)
                lineStart = True

            Else

                If lineStart Then
                    lineStart = False

                Else

                    sb.Append(delimiter)
                End If

                sb.Append(IIf(item Is Nothing, "##null##", item))
            End If

        Next

        Return sb.ToString()

    End Function

    Public Function Flush(Optional ByVal delimiter As String = Nothing, Optional ByVal _
        newLine As String = Nothing) As String

        Flush = ToString(delimiter, newLine)
        MyBase.Clear()

    End Function

    Public Shared Operator +(ByVal this As StringList, ByVal other As Object) As StringList

        this.Add(other)
        Return this

    End Operator

End Class

' ----------------- Ende Datei Stringlist.vb -----------------
' ----------- Ende Projektdatei Calculator.vbproj  -----------
' ------------ Ende Projektgruppe Calculator.sln  ------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.