Tipps und Tricks

Frage (285) zu VB.NET
geprüft mit: VB(9).NET (VS 2008)
betrifft: Chart

Wie kann man Funktionsergebnisse grafisch wie in einem Osszillographen darstellen?

Antwort:

Für die Anzeige von Daten als Linien-Chart eigenet sich ein User Control, in dessen Paint-Methode die Linien gezeichnet werden. Basis einer Linie ist eine Wertereihe (Array von Typ Double, Data-Eigenschaft). Um eine der Größe angepasste Darstellung zu erreichen, sind die Werte auf die Größe des Steuerelementes zu Skalieren und im Fall einer Größenänderung (Resize) ist die Skalierung neu zu berechnen. Das vorliegende Beispiel ermöglicht die Darstellung mehrerer Wertereihen (2-dimensionales Array langer Gleitkommanzahlen) in unterschiedlichen Farben und und mit Beschriftungen. Für alle Wertereihen gibt es eine gemeinsame Wertereihe für die Abszissenwerte. Mit einer nichtlinearen Wertebelegung dieser gemeinsamen Wertereihe können beispielsweise logarithmische Darstellungen erreicht werden. Die Werte der gemeinsamen Wertereihe dienen als Beschriftung der Abszisse. Die Ordinate ist in 10 Abschnitten mit den Werten aus den Wertebereichen aller Wertereihen beschriften (vom Minimalwert bis zum Maximalwert über alle Wertereihen). Für die Abszissen- und Ordinatenbeschriftung kann ein Fornatstring angegeben werden (FormatX- und FormatY-Eigenschaften). Optional können Farben zugeordnet werden, in denen die einzelnen Linien gezeichnet werden (Colors-Eigenschaft vom Typ Color()). Zu jeder Linie kann optional eine Beschriftung eingeben werden, die rechts mittig in der Grafik angezeigt wird (mit Farbverweis auf die Linie, Descriptions-Eigenschaft vom Typ String()).

Zur Demonstration der Darstellung einer sin- und cos-Funktion kann der folgende Programmcode dienen, der in den Codeteil eines leeren Formulars einer VB9-Windows-Anwendung zu kopieren ist. Über einen Zeitgeber werden die aktuellen Daten erzeugt aun angezeigt, so dass das dargestellte Bild wie in einem Osszillographen verschoben wird.

[vb]

Option Infer On

Option Strict On

Public Class Form1

Dim chart As ucChartLine

Private Sub Form1_Load(ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles MyBase.Load

chart = New ucChartLine With { _

.Font = New Font(Me.Font.FontFamily, 10, FontStyle.Regular), _

.Location = New Point(10, 10), _

.Size = New Size(Me.Width - 40, Me.Height - 60), _

.Anchor = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top, _

.Data = GetArray(), _

.Colors = New Color() {Color.Red, Color.Green}, _

.Descriptions = New String() {"sin", "cos"}, _

.FormatX = "#0.0", _

.FormatY = "0.00"}

Me.Controls.Add(chart)

Dim t As New Timer

t.Interval = 200

AddHandler t.Tick, AddressOf t_Tick

t.Start()

End Sub

Private Sub t_Tick(ByVal sender As Object, ByVal e As EventArgs)

For i = 0 To arr.GetUpperBound(1) - 1

arr(0, i) = arr(0, i + 1)

arr(1, i) = arr(1, i + 1)

arr(2, i) = arr(2, i + 1)

Next

arr(0, arr.GetUpperBound(1)) = w

arr(1, arr.GetUpperBound(1)) = Math.Sin(w)

arr(2, arr.GetUpperBound(1)) = Math.Cos(w)

w += Math.PI / 180

chart.ReCalc()

End Sub

Dim arr(2, 359) As Double

Dim w As Double

Private Function GetArray() As Double(,)

For k = 0 To arr.GetUpperBound(1)

arr(0, k) = Double.NaN

arr(1, k) = Double.NaN

arr(2, k) = Double.NaN

Next

Return arr

End Function

End Class

Public Class ucChartLine

Inherits UserControl

Dim sf As New StringFormat

Sub New()

sf.Alignment = StringAlignment.Far

sf.LineAlignment = StringAlignment.Center

End Sub

''' <summary>

''' Index 0: 0 - Abszissenwerte; 1, 2 ... Wertereihen

''' Index 1: Werte (0 - Lage auf X-Achse; 1, 2 ... Punktwert)

''' </summary>

''' <remarks></remarks>

Private _a As Double(,)

Public WriteOnly Property Data() As Double(,)

Set(ByVal value As Double(,))

_a = value

CalcMinMax()

CalcTransform()

End Set

End Property

Public Sub ReCalc()

CalcMinMax()

CalcTransform()

Me.Refresh()

End Sub

Dim _colors() As Color

Public WriteOnly Property Colors() As Color()

Set(ByVal value As Color())

_colors = value

End Set

End Property

Dim _desc() As String

Public WriteOnly Property Descriptions() As String()

Set(ByVal value As String())

_desc = value

End Set

End Property

Dim _formatx As String = "#0"

Public WriteOnly Property FormatX() As String

Set(ByVal value As String)

_formatx = value

CalcTransform()

End Set

End Property

Dim _formaty As String = "#0.00"

Public WriteOnly Property FormatY() As String

Set(ByVal value As String)

_formaty = value

CalcTransform()

End Set

End Property

Dim minx, maxx, miny, maxy As Double

Private Sub CalcMinMax()

minx = Double.MaxValue

maxx = Double.MinValue

miny = Double.MaxValue

maxy = Double.MinValue

For i = 0 To _a.GetUpperBound(1)

If Not Double.IsNaN(_a(0, i)) Then

If minx > _a(0, i) Then minx = _a(0, i)

If maxx < _a(0, i) Then maxx = _a(0, i)

End If

For k = 1 To _a.GetUpperBound(0)

If Not Double.IsNaN(_a(0, i)) Then

If miny > _a(k, i) Then miny = _a(k, i)

If maxy < _a(k, i) Then maxy = _a(k, i)

End If

Next

Next

End Sub

Dim factx, facty As Double

Dim tm As Drawing2D.Matrix

Dim recx, recy, rec0, recd As RectangleF

Dim border As Single = Me.FontHeight

Private Sub CalcTransform()

recx = New RectangleF() ' Rechteck für Abszissenbeschriftung

recy = New RectangleF() ' Rechteck für Ordinatenbeschriftung

' Größenberechnung der Beschriftung

Dim g As Graphics = Me.CreateGraphics

Dim sz As SizeF ' Zwischenspeicher für Ermittlung der maximalen Größe

recx.Size = g.MeasureString(Format(minx, _formatx), Me.Font) ' Abszissenbeschriftung

sz = g.MeasureString(Format(maxx, _formatx), Me.Font)

If sz.Width > recx.Width Then recx.Size = sz

recy.Size = g.MeasureString(Format(miny, _formaty), Me.Font) 'Ordinatenbeschriftung

sz = g.MeasureString(Format(maxy, _formaty), Me.Font)

If sz.Width > recy.Width Then recy.Size = sz

If _desc IsNot Nothing Then

recd = New RectangleF

For k = 0 To _desc.Length - 1

sz = g.MeasureString(_desc(k), Me.Font)

If sz.Width > recd.Width Then recd.Size = sz

Next

End If

g.Dispose()

'

' Bereich für Grafik

rec0 = New RectangleF(recy.Width + border, border, Me.Width - recy.Width - 2 * border, Me.Height - recx.Width - 2 * border)

' Skalierung

factx = rec0.Width / (maxx - minx)

facty = rec0.Height / (maxy - miny)

' Transformationsmatrix

If tm IsNot Nothing Then tm.Dispose()

tm = New Drawing2D.Matrix(1, 0, 0, -1, 0, 0)

tm.Translate(rec0.X, rec0.Y + rec0.Height, Drawing2D.MatrixOrder.Append)

End Sub

Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)

Dim ps(_a.GetUpperBound(1)) As PointF ' Polylinienpunkte

Dim xpos As Single = 0

Dim xprev1 As Single = 0

Dim xprev2 As Single = -Me.Width

Dim pt1, pt2 As PointF

With e.Graphics

.Clear(Me.BackColor)

.DrawRectangles(Pens.Black, New RectangleF() {rec0})

' Ordinatenbeschriftung

pt1 = New PointF(rec0.X, recx.Height / 2)

pt2 = New PointF(pt1.X - 10, pt1.Y)

recy.X = border / 3

.TranslateTransform(0, rec0.Y + rec0.Height - recy.Height / 2)

For i = 0 To 10

.DrawString(Format(miny + i * (maxy - miny) / 10, _formaty), Me.Font, Brushes.Black, recy, sf)

.DrawLine(Pens.Black, pt1, pt2)

.TranslateTransform(0, -rec0.Height / 10)

Next

' Abszissenbeschriftung

.ResetTransform()

pt1 = New PointF(Me.Height - rec0.Height - border, recy.Height / 2)

pt2 = New PointF(pt1.X - 10, pt1.Y)

recx.X = border / 3

.RotateTransform(-90)

.TranslateTransform(-Me.Height, rec0.X - recx.Height / 2)

For i = 0 To _a.GetUpperBound(1)

If Not Double.IsNaN(_a(0, i)) Then

xpos = CSng((_a(0, i) - minx) * factx)

.TranslateTransform(0, xpos - xprev1)

If xpos - xprev2 > recx.Height Then

.DrawString(Format(_a(0, i), _formatx), Me.Font, Brushes.Black, recx, sf)

.DrawLine(Pens.Black, pt1, pt2)

xprev2 = xpos

End If

xprev1 = CSng((_a(0, i) - minx) * factx)

End If

Next

' Graphik

.Transform = tm

For k = 1 To _a.GetUpperBound(0)

For i = 0 To _a.GetUpperBound(1)

If Not Double.IsNaN(_a(k, i)) AndAlso minx < maxx Then

ps(i) = New PointF(CInt((_a(0, i) - minx) * factx), CInt((_a(k, i) - miny) * facty))

End If

Next

If _colors IsNot Nothing AndAlso _colors.GetUpperBound(0) >= k - 1 Then

Using p As New Pen(_colors(k - 1))

.DrawLines(p, ps)

End Using

Else

.DrawLines(Pens.Black, ps)

End If

Next

' Beschriftung

.ResetTransform()

pt1 = New PointF(recd.X, recd.Height / 2)

pt2 = New PointF(pt1.X - 20, pt1.Y)

.TranslateTransform(rec0.X + rec0.Width - recd.Width, rec0.Y + (rec0.Height - _desc.Length * Me.FontHeight) / 2)

For k = 0 To _desc.Length - 1

If _colors IsNot Nothing AndAlso _colors.GetUpperBound(0) >= k Then

Using p As New Pen(_colors(k))

.DrawLine(p, pt1, pt2)

End Using

Else

.DrawLine(Pens.Black, pt1, pt2)

End If

.DrawString(_desc(k), Me.Font, Brushes.Black, recd)

.TranslateTransform(0, Me.FontHeight)

Next

End With

End Sub

Protected Overrides Sub OnResize(ByVal e As System.EventArgs)

CalcTransform()

Me.Refresh()

End Sub

Protected Overrides Sub Dispose(ByVal disposing As Boolean)

If tm IsNot Nothing Then tm.Dispose() ' Tranform-Matrix

MyBase.Dispose(disposing)

End Sub

End Class

[/vb]

Stand des Beitrages: 15.12.09 07:38, zuletzt geändert: 15.12.09 07:38



Bitte wählen sie den Haupt-Themenbereich aus
Bitte geben sie einen Suchbegriff ein

Die hier dargestellten Tipps und Tricks sind das Ergebnis selbst ersteller Lösungsvarianten, die für Projekte und Schulungen erarbeitet wurden.