Tipp-Upload: VB.NET 0169: y = f(x) mit Attributen und der Reflection

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Grafik
• Mathematik

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Funktionsplotter, f(x), y = f(x), Reflection, Attribute, <, >

Der Vorschlag wurde erstellt am: 01.01.2008 15:50.
Die letzte Aktualisierung erfolgte am 02.01.2008 13:04.

Zurück zur Übersicht

Beschreibung  

Dieser Tipp ist quasi eine Ergänzung zu Oliver Meyers  Tippvorschlag 168, in dem er über Delegaten Funktionsdarstellungen organisiert. Aber wie heißt es so schön: There is more than one way to do it, und deshalb zeigt dieser Tipp die selbe Funktionalität, aber diesmal unter Verwendung von Attributen und der Reflection. Vorteil hierbei: Es muss letztlich kein Code außer der eigentlichen Funktion angepasst werden, um sie zu verwenden.

Hinweis: Ein Großteil des Quellcodes ist dabei aus dem "Originalquellcode" von Oliver Meyer übernommen.

Update vom 2.1.2008 - Umbenennungen und ein Aufruf wurde verbessert.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [13,39 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 FuncByReflection.sln  --------
' ------- Anfang Projektdatei FuncByReflection.vbproj  -------
' ---------------- Anfang Datei Attribute.vb  ----------------
Option Infer Off
Option Strict On
Option Explicit On

Imports System

''' <summary>
''' Ein beschreibendes Attribut für mathematische Funktionen
''' </summary>
''' <remarks></remarks>
<AttributeUsage(AttributeTargets.Method)> Public Class MathFuncAttribute

    Inherits Attribute

    Private ReadOnly mName As String
    Private ReadOnly mStandardCoefficients As IEnumerable(Of Double)

    Public Sub New(ByVal Name As String, ByVal ParamArray StandardCoefficients() As Double)

        mName = Name
        mStandardCoefficients = StandardCoefficients

    End Sub

    Public ReadOnly Property Name() As String
        Get
            Return mName

        End Get

    End Property

    Public ReadOnly Property Coefficients() As IEnumerable(Of Double)
        Get
            Return mStandardCoefficients

        End Get

    End Property

End Class

' ----------------- Ende Datei Attribute.vb  -----------------
' ------------------ Anfang Datei Form1.vb  ------------------
Public Class Form1

    Private mView As New MathFunctionView
    Private mDatabase As New Dictionary(Of String, MathFunction)
    Private mFunctions As New Functions

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles MyBase.Load

        mDatabase.ReflectFunctions(mFunctions) ' Das ist alles

        cboFunction.Items.AddRange(mDatabase.Keys.ToArray)
        cboFunction.SelectedIndex = 0

    End Sub

    Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize

        With Me.ClientSize

            PictureBox1.Size = New Size(.Width - PictureBox1.Left - 12, .Height - _
                PictureBox1.Top - 12)

        End With

        mView.Size = PictureBox1.Size

    End Sub

    Private Sub ChangeFunction(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles cboFunction.SelectedIndexChanged

        If cboFunction.SelectedItem IsNot Nothing Then
            mView.DrawFunction(mDatabase(cboFunction.SelectedItem))
            PictureBox1.Refresh()
        End If

    End Sub

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As _
        System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint

        If mView.Buffer IsNot Nothing Then
            e.Graphics.DrawImage(mView.Buffer, 0, 0)

        Else

            e.Graphics.Clear(PictureBox1.BackColor)
        End If

    End Sub

End Class

' ------------------- Ende Datei Form1.vb  -------------------
' ---------------- Anfang Datei Functions.vb  ----------------
Option Infer Off
Option Strict On
Option Explicit On

Public Delegate Function MathFunction(ByVal x As Double) As Double

Public Class Functions

    Public C As List(Of Double) ' Konstantenparameter

    <MathFunc("Konstante Funktion", 3)> _
        Public Function ConstFunc(ByVal x As Double) As Double

        Return C(0)

    End Function

    <MathFunc("Lineare Funktion", 0.5, 15)> _
        Public Function Linear(ByVal x As Double) As Double

        Return C(0) * x + C(1)

    End Function

    <MathFunc("Quadratische Funktion", 0.01, 0, -100)> _
        Public Function Quadratic(ByVal x As Double) As Double

        Return Linear(x) * x + C(2)

    End Function

    <MathFunc("Kubische Funktion", 0.0001, 0, -2, 0)> _
        Public Function Cubic(ByVal x As Double) As Double

        Return Quadratic(x) * x + C(3)

    End Function

    <MathFunc("Sinus", 0.05, 100, 20, 0)> _
        Public Function Sinus(ByVal x As Double) As Double

        Return Math.Sin(Linear(x)) * C(2) + C(3)

    End Function

    <MathFunc("Exponentialfunktion", 0.007, 0, 50, 0)> _
        Public Function Exponent(ByVal x As Double) As Double

        Return Math.Exp(Linear(x)) * C(2) + C(3)

    End Function

    <MathFunc("DamperedHarmonic", -0.007, 0, 25, 0, 0.1, 10, 0)> _
        Public Function DamperedHarmonic(ByVal x As Double) As Double

        Return Exponent(x) * Math.Sin(C(4) * x + C(5)) + C(6)

    End Function

End Class

' ----------------- Ende Datei Functions.vb  -----------------
' ----------------- Anfang Datei Plotter.vb  -----------------
Public Class MathFunctionView

    Public Buffer As Bitmap ' wird neu gezeichnet

    Private mAxis As Bitmap ' statisch
    Private mMtrx As Drawing2D.Matrix
    Private mSize As Size

    Public WriteOnly Property Size() As Size
        Set(ByVal value As Size)
            mSize = value
            mMtrx = New System.Drawing.Drawing2D.Matrix()

            With mSize
                mMtrx.Translate(.Width \ 2, .Height \ 2)
                mMtrx.Scale(1.0F, -1.0F) ' (2.0F, -2.0F)
            End With

            DrawAxis()

        End Set

    End Property

    Private Sub DrawAxis()

        With mSize
            mAxis = New Bitmap(.Width, .Height)

            Dim gr As Drawing.Graphics = Graphics.FromImage(mAxis)

            gr.DrawLine(Pens.Black, New Point(0, .Height \ 2), New Point(.Width, .Height \ 2))
            gr.DrawLine(Pens.Black, New Point(.Width \ 2, 0), New Point(.Width \ 2, .Height))
        End With

    End Sub

    Public Sub DrawFunction(ByVal f As MathFunction)

        Buffer = New Bitmap(mAxis)

        Dim xMin As Double = -mSize.Width \ 2
        Dim xMax As Double = Math.Abs(xMin)
        Dim x, y As Double
        Dim newPt, oldPt As Point
        Dim gr As Drawing.Graphics = Graphics.FromImage(Buffer)

        gr.Transform = mMtrx

        If f Is Nothing Then Exit Sub

        Try

            For x = xMin To xMax
                y = f(x) ' so hier ist also jetzt endlich das y = f(x), einfacher wirds nicht
                newPt = New Point(CInt(x), CInt(y))

                If x = xMin Then oldPt = newPt ' noch bevor gezeichnet wird!
                gr.DrawLine(Pens.Blue, oldPt, newPt)
                oldPt = newPt
            Next

        Catch

            '
        End Try

    End Sub

End Class

' ------------------ Ende Datei Plotter.vb  ------------------
' ---------------- Anfang Datei Reflection.vb ----------------
Option Infer Off
Option Strict On
Option Explicit On

Imports System.Reflection
Imports System.Runtime.CompilerServices

<HideModuleName()> Public Module ReflectFunctions

    ''' <summary>
    ''' Funktionen einlesen
    ''' </summary>
    ''' <param name="Dictionary"></param>
    ''' <param name="FuncContainer"></param>
    ''' <remarks></remarks>
    <Extension()> Sub ReflectFunctions(ByVal Dictionary As Dictionary(Of String, _
        MathFunction), ByVal FuncContainer As Functions)

        Dim TypeOfContainer As Type = GetType(Functions)

        ' Methoden durchlaufen
        For Each Method As MethodInfo In TypeOfContainer.GetMethods()

            ' Attribut rauskramen

            ' Original mit Linq
            ' Dim MathAttr As MathFunc = DirectCast((From Attr As Attribute In
            ' Attribute.GetCustomAttributes(Method) Where TypeOf Attr Is MathFunc Select
            ' Attr).FirstOrDefault, MathFunc)

            ' Besser (von 'Spatzenkanonier')
            Dim MathAttr As MathFuncAttribute = Attribute.GetCustomAttributes(Method).OfType( _
                Of MathFuncAttribute).FirstOrDefault

            Dim temp As MethodInfo = Method ' Warnung vermeiden

            If MathAttr IsNot Nothing Then

                Dictionary.Add(MathAttr.Name, Function(x As Double) Invoker(temp, MathAttr, _
                    FuncContainer, x))

            End If

        Next

    End Sub

    Private Function Invoker(ByVal Method As MethodInfo, ByVal Attr As MathFuncAttribute, _
        ByVal FuncContainer As Functions, ByVal x As Double) As Double

        FuncContainer.C = New List(Of Double)(Attr.Coefficients)
        Return CDbl(Method.Invoke(FuncContainer, New Object() {x}))

    End Function

End Module

' ----------------- Ende Datei Reflection.vb -----------------
' -------- Ende Projektdatei FuncByReflection.vbproj  --------
' --------- Ende Projektgruppe FuncByReflection.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.