Tipp-Upload: VB.NET 0004: Ownerdrawn ChartControl

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
• Steuerelemente

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Ownerdraw, Matrix, Graphicspath, Drawing, GDI+, Stringformat, Pen, Komponente, Component, Spline,BinarySearch, binäre Suche

Der Vorschlag wurde erstellt am: 25.08.2007 02:30.
Die letzte Aktualisierung erfolgte am 08.04.2008 14:00.

Zurück zur Übersicht

Beschreibung  

Neben TU0016 (ownerdrawn Listbox-Item) und TU0018 (bewegliche Figuren) hier ein Control, daß sich selbst zeichnet (für LinienCharts).
Die (in TU0018 vorgestellten) Klassen Matrix und Graphicspath werden für den aufwändigen Kurven-Hintergrund noch mehr beansprucht:
Letzterer stellt sich selbsttätig auf einen gegebenen Wertebereich bei gegebener Control-Größe ein.
Beschriftung und Orientierungslinien sind so ausgerichtet, daß die Beschriftung ein Minimum an Nachkommastellen anzeigt.
Der Abstand der Orientierungslinien beträgt nie weniger als 15 oder mehr als 40mm.
Außerdem Verwendung der StringFormat-Klasse, und etwas speziellerer Properties von Pen.
Das Control kann (nach Kompilierung) im Form-Designer verwendet werden.

Anregungen kann man hier loswerden:
http://foren.activevb.de/cgi-bin/foren/view.pl?&forum=13&msg=1378&root=1378&page=1

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [17,52 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 PaintChart.sln  -----------
' ---------- Anfang Projektdatei PaintChart.vbproj  ----------
' --------------- Anfang Datei ChartControl.vb ---------------
' IDE-Voreinstellungen:
' Option Strict On
' Option Explicit On

' Projekt-Voreinstellungen:
' Imports System.Windows.Forms
' Imports Microsoft.VisualBasic.ControlChars

Imports System.Drawing
Imports System.Drawing.Drawing2D

Public Class ChartControl

    Inherits Control

    Private _Points(-1) As PointF
    Private _CurvePath As New Drawing2D.GraphicsPath
    Private _CurvePen As System.Drawing.Pen
    Private _PlotPath As New Drawing2D.GraphicsPath
    Private _PlotPen As System.Drawing.Pen
    Private _TextPath As New Drawing2D.GraphicsPath
    Private _TextBrush As New SolidBrush(Color.Blue)
    Private _GridPath As New Drawing2D.GraphicsPath
    Private _GridPen As System.Drawing.Pen

    Private _DisplayMatrix As New Drawing2D.Matrix

    Private _SFX As New StringFormat ' StringFormat der X-Achsen-Beschriftung
    Private _SFY As New StringFormat

    Private _GridRange As RectangleF ' Innenbereich des Charts

    Private _ValueRange As RectangleF = RectangleF.Empty ' fasst minimale und maximale X / Y
                                                         ' -Werte der _Points in einer
                                                         ' Struktur - entspricht also dem
                                                         ' Chart-Innenbereich

    Private ReadOnly _GridCell20mm As New SizeF
    Private _DataError As String = "Keine Werte"

    Protected Overrides Sub Dispose(ByVal disposing As Boolean)

        If Not MyBase.IsDisposed Then

            ' Da lohnt sich das Disposen mal so richtig!
            For Each D As IDisposable In New IDisposable() { _CurvePath, _CurvePen, _
                _PlotPath, _PlotPen, _TextPath, _TextBrush, _GridPath, _GridPen, _
                _DisplayMatrix, _SFX, _SFY}

                D.Dispose()
            Next

        End If

        MyBase.Dispose(disposing)

    End Sub

    Public Sub New()

        MyBase.DoubleBuffered = True ' mindert flackern
        Me.MinimumSize = New Size(50, 30)
        _GridPen = New Pen(Color.Black)
        _GridPen.DashPattern = New Single() {2, 4}
        _CurvePen = New Pen(Color.Red, 1)
        _PlotPen = New Pen(Color.FromArgb(0, 100, 0), 2) ' sehr dunkles Grün
        _PlotPen.DashPattern = New Single() {4, 2} ' dashed, damit die Plot-Kreuze ein Loch
                                                   ' inne Mitte haben

        Using G As Graphics = MyBase.CreateGraphics

            ' anvisierte Gittergröße: 20mm
            ' Davon wird aber erheblich abgewichen, da die Minimierung der Nachkommastellen
            ' der Achsenbeschriftung wichtiger ist
            Const InchTo20mm As Single = 20 / 25.4F
            _GridCell20mm = New SizeF(G.DpiX * InchTo20mm, G.DpiY * InchTo20mm)
        End Using

        MyBase.ForeColor = Color.Blue

        ' X-Achsen-Beschriftungs-StringFormat
        _SFX.Alignment = StringAlignment.Far ' richtet Text rechtsbündig am angegebenen
                                             ' Zielpunkt aus (Text erscheint links vom
                                             ' Zielpunkt)
        _SFX.LineAlignment = StringAlignment.Center

        ' Y-Achsen-Beschriftungs-StringFormat
        _SFY.Alignment = StringAlignment.Center
        _SFY.LineAlignment = StringAlignment.Near ' richtet Text obenbündig am angegebenen
                                                  ' Zielpunkt aus (Text erscheint unterm
                                                  ' Zielpunkt)

    End Sub

    Public Sub ChangePoints(ByVal Points As ICollection(Of PointF))

        If Points Is Nothing Then
            _Points = New PointF() {}

        Else

            _Points = ToArray(Points) ' klonen
        End If

        ApplyChanges()

    End Sub

    ''' <summary>
    ''' Ein Diagramm mit wenigen Punkten wird anders dargestellt
    ''' </summary>
    Private ReadOnly Property HasFewPoints() As Boolean
        Get
            Return _Points.Length < 100

        End Get

    End Property

    ' Überträgt _Points nach _CurvePath. Dabei muß validiert werden
    Private Function BuildCurvePath() As Boolean

        Select Case _Points.Length

            Case 0
                _DataError = "Keine Werte"

            Case 1

                _DataError = String.Concat("Ein einzelner Punkt ", Lf, _Points(0), Lf, " " & _
                    "ist nicht im Diagramm darstellbar")

            Case Else

                ' ######## Hier wird die Kurve gebildet!! #######
                If HasFewPoints Then

                    ' als Spline-Kurve
                    _CurvePath.AddCurve(_Points)

                Else

                    ' durch Geraden verbunden
                    _CurvePath.AddLines(_Points)
                End If

                ' ########## Danke, das wars schon ############
                _ValueRange = _CurvePath.GetBounds

                With _ValueRange

                    If .Height <> 0 AndAlso .Width <> 0 Then
                        _DataError = ""
                        Return True

                    ElseIf .Equals(RectangleF.Empty) Then

                        _DataError = String.Concat("Das Diagramm ist nicht darstellbar, " & _
                            "weil alle", " Punkte auf derselben Position", Lf, _Points(0), _
                            " liegen.")

                    Else

                        _DataError = String.Concat("Der Wertebereich von ", Lf, .Location, _
                            " bis ", New PointF(.Right, .Bottom), Lf, " ist nicht im " & _
                            "Diagramm darstellbar, da er", " keine flächige Ausdehnung " & _
                            "hat.")

                    End If

                End With

        End Select

        Return False

    End Function

    Private Sub ApplyChanges()

        _CurvePath.Reset()
        _PlotPath.Reset()
        _GridPath.Reset()
        _TextPath.Reset()
        Me.Invalidate() ' Neuzeichnen anfordern...

        If Not BuildCurvePath() Then Return ' ... egal, ob hier abgebrochen wird oder nicht

        Dim _Scale As New SizeF(_GridRange.Width / _ValueRange.Width, _GridRange.Height / _
            _ValueRange.Height)

        With _DisplayMatrix
            .Reset()
            .Translate(-_ValueRange.X, -_ValueRange.Y, MatrixOrder.Append) ' Wertebereich
                                                                           ' auf Nullpkt
                                                                           ' schieben
            .Scale(_Scale.Width, _Scale.Height, MatrixOrder.Append) ' auf GridRange skalieren
            .Translate(_GridRange.X, _GridRange.Y, MatrixOrder.Append) ' GridRange-Offset hinzufügen
            .Scale(1, -1, MatrixOrder.Append) ' über die X-Achse spiegeln (also aussm Control raus)
            .Translate(0, MyBase.Height, MatrixOrder.Append) ' wieder in den sichtbaren
                                                             ' Bereich holen
        End With

        BuildBackground(_Scale)
        _CurvePath.Transform(_DisplayMatrix)

        If HasFewPoints Then BuildPlotPath()

    End Sub

    Private Sub BuildPlotPath()

        ' an jedem Punkt ein Kreuzchen malen
        Dim Pts As PointF() = ToArray(_Points)

        _DisplayMatrix.TransformPoints(Pts)

        With _PlotPath

            For Each Pt As PointF In Pts
                Const Offs As Single = 7.071

                ' 2 Diagonalen
                .StartFigure()
                .AddLine(Pt.X - Offs, Pt.Y - Offs, Pt.X + Offs, Pt.Y + Offs)
                .StartFigure()
                .AddLine(Pt.X - Offs, Pt.Y + Offs, Pt.X + Offs, Pt.Y - Offs)
            Next

        End With

    End Sub

    ''' <returns>Abstands-Werte für Orientierungslinien</returns>
    Private Function GetSnapValue(ByVal Number As Double) As Single

        ' sucht in der Zahlenfolge {... 0.1, 0.2, 0.5, 1, 2, 5, 10, ...} nach dem Number am
        ' nächsten kommenden Wert. Das ermöglicht Achsenbschriftungen mit möglichst wenig
        ' Nachkommastellen
        ' Int(Math.Log10(Val)): Komma-Position ( negativ für: 0 < Val < 1 )
        Dim DecimalRangeBottom As Double = 10 ^ Int(Math.Log10(Number))
        Dim Numb As Double
        Dim Prev As Double = DecimalRangeBottom

        ' testet das Doppelte, 5-fache, 10-fache
        For Each Factor As Double In New Double() {2, 5, 10}
            Numb = Factor * DecimalRangeBottom

            If Numb >= Number Then Exit For
            Prev = Numb
        Next

        If Numb - Number < Number - Prev Then
            Return CSng(Numb)

        Else

            Return CSng(Prev)
        End If

    End Function

    ''' <returns>Anzahl der Segmente, in die man Fullsize unterteilen kann</returns>
    Private Function AlignCount( _
              ByVal FullSize As Single, _
              ByVal SegmentSize As Single, _
              Optional ByVal UpperSide As Boolean = True) As Integer

        AlignCount = CInt(Int(FullSize / SegmentSize))

        ' Die Summe der Segmente (horizontal o. waagerecht) ist eigentlich immer kleiner als
        ' FullSize. Außer, Value ist ganzzahlig teilbar durch SegmentSize.
        Dim Rest As Single = FullSize - AlignCount * SegmentSize

        If UpperSide Then

            ' Gib eine Anzahl Segmente zurück, deren Summe >= Value
            If Rest > SegmentSize * 0.005F Then AlignCount += 1

        Else

            ' Gib eine Anzahl Segmente zurück, deren Summe <= Value
            If Rest > SegmentSize * 0.995F Then AlignCount += 1
        End If

    End Function

    Private Sub BuildBackground(ByVal Scale As SizeF)

        ' Das wäre die Schrittweite der Werte in X- und Y-Richtung beim
        ' Beschriftungs-Abstand von 20mm
        Dim ValueStep20mm As New SizeF(_GridCell20mm.Width / Scale.Width, _
            _GridCell20mm.Height / Scale.Height)

        ' Wir suchen aber eine "runde" Schrittweite ( möglichst wenig Nachkommastellen )
        Dim ValueStep As New PointF(GetSnapValue(ValueStep20mm.Width), GetSnapValue( _
            ValueStep20mm.Height))

        Dim Start As New Point(AlignCount(_ValueRange.X, ValueStep.X), AlignCount( _
            _ValueRange.Y, ValueStep.Y))

        Dim [End] As New Point(AlignCount(_ValueRange.Right, ValueStep.X, False), AlignCount( _
            _ValueRange.Bottom, ValueStep.Y, False))

        SetGridLines(Start, [End], ValueStep)
        SetGridCaptions(Start, [End], ValueStep)

    End Sub

    Private Sub SetGridLines( _
                ByVal Start As Point, _
                ByVal [End] As Point, _
                ByVal ValueStep As PointF)

        With _GridPath

            For I As Integer = 0 To [End].X - Start.X

                Dim X As Single = (Start.X + I) * ValueStep.X

                .StartFigure()
                .AddLine(X, _ValueRange.Top, X, _ValueRange.Bottom) ' Vertikale
            Next

            For I As Integer = 0 To [End].Y - Start.Y

                Dim Y As Single = (Start.Y + I) * ValueStep.Y

                .StartFigure()
                .AddLine(_ValueRange.Left, Y, _ValueRange.Right, Y) ' Horizontale
            Next

            .AddRectangle(_ValueRange) ' Rahmen drum
            .Transform(_DisplayMatrix) ' Auf Größe bringen und vertikal spiegeln

        End With

    End Sub

    ' _TextPath konstruieren
    Private Sub SetGridCaptions( _
                ByVal Start As Point, _
                ByVal [End] As Point, _
                ByVal ValueStep As PointF)

        ' X-Achse beschriften
        Dim UBound As Integer = [End].X - Start.X
        Dim Locations(UBound) As PointF
        Dim Entries(UBound) As Single

        ' Entries und Locations ermitteln
        For I As Integer = 0 To UBound
            Entries(I) = (I + Start.X) * ValueStep.X
            Locations(I) = New PointF(Entries(I), _ValueRange.Top)
        Next

        _DisplayMatrix.TransformPoints(Locations) ' Locations transformieren

        ' an den Locations die Entries hinschreiben
        WriteAxis(Locations, Entries, _SFY)

        ' Y-Achse beschriften
        UBound = [End].Y - Start.Y
        ReDim Locations(UBound)
        ReDim Entries(UBound)

        For I As Integer = 0 To UBound
            Entries(I) = (I + Start.Y) * ValueStep.Y
            Locations(I) = New PointF(_ValueRange.X, Entries(I))
        Next

        ' Y-Achs-Beschriftung etwas nach links versetzen
        _DisplayMatrix.Translate(-7, 0, MatrixOrder.Append)
        _DisplayMatrix.TransformPoints(Locations)
        _DisplayMatrix.Translate(7, 0, MatrixOrder.Append)
        WriteAxis(Locations, Entries, _SFX)

    End Sub

    Private Sub WriteAxis( _
              ByVal Locations() As PointF, _
              ByVal Entries() As Single, _
              ByVal SF As StringFormat)

        For I As Integer = 0 To Locations.Length - 1

            With MyBase.Font

                _TextPath.AddString(Entries(I).ToString, .FontFamily, .Style, .Size, _
                    Locations(I), SF)

            End With

        Next

    End Sub

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

        MyBase.OnFontChanged(e)
        Me.Invalidate()

    End Sub

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

        MyBase.OnForeColorChanged(e)
        _TextBrush.Dispose()
        _TextBrush = New SolidBrush(MyBase.ForeColor)
        Me.Invalidate()

    End Sub

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)

        MyBase.OnPaint(e)

        Dim G As Graphics = e.Graphics

        If Not String.IsNullOrEmpty(_DataError) Then
            _TextPath.Reset()

            With MyBase.Font

                _TextPath.AddString(String.Concat(MyBase.Text, Lf, _DataError), .FontFamily, _
                    .Style, .Size, Point.Empty, StringFormat.GenericDefault)

            End With

        Else

            G.DrawPath(_GridPen, _GridPath)
            G.DrawPath(_CurvePen, _CurvePath)
            G.DrawPath(_PlotPen, _PlotPath)
        End If

        ControlPaint.DrawBorder(G, Me.ClientRectangle, Color.Black, ButtonBorderStyle.Solid)
        G.SmoothingMode = SmoothingMode.AntiAlias ' Textdarstellung erfordert AntiAliasing
        G.FillPath(_TextBrush, _TextPath)

    End Sub

    Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)

        MyBase.OnSizeChanged(e)

        Static PreventSizeZero As New Size(1, 1)

        ' Gut zu wissen: Über die im Designer einstellbare Property MinimumSize wird der
        ' Nullpkt des Diagramm-Innenbereichs gesetzt.
        With MyBase.MinimumSize

            _GridRange = New RectangleF(New Point(.Width - 10, .Height - 10), PreventSizeZero _
                + MyBase.Size - MyBase.MinimumSize)

        End With

        ApplyChanges()

    End Sub

End Class ' ChartControl

' ---------------- Ende Datei ChartControl.vb ----------------
' ----------------- Anfang Datei frmChart.vb -----------------
Imports System.Drawing
Imports System.Math

Public Class frmChart

    Private Sub frmChart_Load(ByVal sender As Object, ByVal e As EventArgs) _
                Handles Me.Load

        Me.ComboBox1.DataSource = New IList(Of PointF)() { Create400Points(), (New _
            PointList)(0.2, -8)(1, -1)(1.5, -1)(3.333, 8)(4.3, 8), (New PointList)(-195, -8)( _
            -180, -1)(0, -1)(30.333, 8)(33, 8), (New PointList)(0.2, -8)(1, -1), (New _
            PointList), (New PointList)(2, 3)(2, 4)(2, 3), (New PointList)(2, 3)(3, 3)(4, 4), _
            New PointList)(2, 3)(2, 3)(2, 3)}

    End Sub

    Private Function Create400Points() As PointF()

        Const PointCount As Integer = 400

        Dim RetVal(PointCount - 1) As PointF
        Dim F As Integer = 10
        Dim tStep As Single = 1 / (PointCount - 1) ' 400 Pkte definieren 399 Steps
        Dim A As Integer = 320

        For I As Integer = 0 To PointCount - 1

            Dim t As Single = I * tStep
            Dim Angle As Double = 2 * PI * F * t
            Dim Y As Double = A * Sin(Angle) * Sin(Angle * 3.2) ^ 3 * Sin(0.1 * Angle)

            RetVal(I) = New PointF(t, A * CSng(Y))
        Next

        Return RetVal

    End Function

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

        ChartControl1.ChangePoints(DirectCast(ComboBox1.SelectedValue, IList(Of PointF)))

    End Sub

End Class ' frmChart

Public Class PointList

    Inherits List(Of PointF)
    ''' <summary>
    ''' diese Default-Property ermöglicht sehr kompakten Initialisierungscode
    ''' </summary>
    Default Public ReadOnly Property AddItem(ByVal X As Single, ByVal Y As Single) As PointList
        Get
            MyBase.Add(New PointF(X, Y))
            Return Me

        End Get

    End Property

End Class ' PointList

' ------------------ Ende Datei frmChart.vb ------------------
' ---------------- Anfang Datei modHelpers.vb ----------------
Module modHelpers

    ''' <summary>
    ''' returnt ein Array mit den kopierten Werten einer gegebenen ICollection(Of T)
    ''' </summary>
    Public Function ToArray(Of T)(ByVal Template As ICollection(Of T)) As T()

        Dim RetVal(Template.Count - 1) As T

        Template.CopyTo(RetVal, 0)
        Return RetVal

    End Function

End Module

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

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