Wenn man Daten graphisch aufbereiten möchte, die nicht in der Einheit PIXEL vorliegen, kann man die Daten per Programm vor dem Zeichnen auf den Pixel-Maßstab umrechnen, oder man verwendet beim Zeichnen eine Transformationsmatrix. Im Namespace 'Drawing.Drawing2D' steht für diesen Zweck die Klasse 'Matrix' bereit. Dabei handelt es sich um eine 3*3-Matrix, deren Elemente aus dem Datentyp 'Single' bestehen. (Fragt man die Elemente einer Instanz dieser Klasse per Methode 'Elements' ab, erhält man eine 1D-Matrix mit SECHS (!) Elementen.) Für die Skalenanpassung müssen folgende Elemente der Matrix (betrachtet als null-basierter Vektor) eingerichtet werden:
Die mit 0 belegten Elemente der Matrix werden nur bei Rotationen benötigt. Die Belegung der Elemente der Matrix erfolgt nicht direkt, sondern über einen der Konstruktoren der Klasse (vgl. Quellcode) oder durch Zuweisungsmethoden dieser Klasse (z.B. Rotate, Scale, Translate). Die Routine 'ScaleMatrix' erstellt eine Transformationsmatrix aus den datenbezogen Parametern (Single) und den graphikbezogenen Parametern (Integer). Die zurückgegebene Matrix enthält die oben genannten vier Skalierungswerte. Die Transformationsmatrix wird einer Instanz von Graphics zugewiesen (Methode: 'Transform'). Danach kann man den Draw-/Fill-Methoden der Graphics-Instanz die skalierten Werte direkt übergeben. Sie werden vor dem Zeichnen automatisch auf die entsprechenden Pixelpositionen umgerechnet. Im Demonstrationsbeispiel werden zwei zufällige Datenvektoren erstellt und eine Transformationsmatrix berechnet, die die Werte in die Abmessungen eines (Pixel-)Rechtecks überträgt, das in einer Bitmap gezeichnet wird. (Extrempunkte können wegen Rundungsfehlern 1 Pixel außerhalb des zulässigen Rechtecks liegen.) Da im Graphics-Objekt eine 'DrawPoint'-Methode fehlt, ist auf 'DrawEllipse' zurückgegriffen worden. Die Daten-Extremwerte (=Skalengrenzen) werden durch die 'Extensions' 'Min', 'Max' bestimmt, die in VB 2008 für eindimensionale Arrays verfügbar sind. In der Praxis wird man noch eine Routine einschalten, die prüft, ob ein zu zeichnender Datenpunkt tatsächlich innerhalb der zulässigen Skalengrenzen liegt (Ausreißer eliminieren). Am Bildschirm sichtbar wird das Ergebnis der Demo-Routine, wenn man eine PictureBox verwendet: PicTureBox1.SizeMode = PictureBoxSizeMode.Zoom Picturebox1.Image = Demo_ScaleMatrix() Die Formeln in der Routine 'ScaleMatrix' ergeben sich durch einfache Umrechnung der linearen Transformations-Formel auf eine additive Konstante und einen Faktor. Skalierungs-Formel: (a - aug) / (aog - aug) = (b - bug) / (bog - bug), wobel a, b jeweils Skalenwerte und ug, og die entsprechenden Skalengrenzwerte sind. ''' <summary> ''' Transformationsmatrix zur Umrechnung der ''' Datenbereiche (x,y) auf ein Graphikrechteck ''' </summary> ''' <param name="ScaleLeft">Skalen-Untergrenze x</param> ''' <param name="ScaleWidth">Skalen-Länge </param> ''' <param name="ScaleTop">Skalen-Untergrenze y</param> ''' <param name="ScaleHeight">Skalen-Länge y</param> ''' <param name="DrawLeft">Zeichnungs-Untergrenze x (Pixel)</param> ''' <param name="DrawWidth">Zeichnungsbreite (Pixel)</param> ''' <param name="DrawTop">Zeichnungs-Untergrenze y</param> ''' <param name="DrawHeight">Zeichnungshöhe (Pixel)</param> ''' <returns>Transformationsmatrix (oder Nothing)</returns> Public Function ScaleMatrix(ByVal ScaleLeft As Double, _ ByVal ScaleWidth As Double, _ ByVal ScaleTop As Double, _ ByVal ScaleHeight As Double, _ ByVal DrawLeft As Integer, _ ByVal DrawWidth As Integer, _ ByVal DrawTop As Integer, _ ByVal DrawHeight As Integer) As Drawing.Drawing2D.Matrix If ScaleWidth < 0.0001 Then Return Nothing If DrawWidth < 1 Then Return Nothing If DrawLeft < 0 Or DrawTop < 0 Then Return Nothing ' Skalierungs-Faktoren Dim sx As Single = CSng(DrawWidth / ScaleWidth) Dim sy As Single = CSng(DrawHeight / ScaleHeight) ' Verschiebungs-Konstanten Dim dx As Single = CSng(DrawLeft - ScaleLeft * sx) Dim dy As Single = CSng(DrawTop - ScaleTop * sy) ' Instanz der Matrix-Klasse Dim mat As New Drawing.Drawing2D.Matrix ' Belegung der Matrix mit den Werten mat.Translate(dx, dy) mat.Scale(sx, sy) ' Rückgabe Return mat ' Alternative ' Return New Drawing.Drawing2D.Matrix(sx, 0, 0, sy, dx, dy) End Function Public Function Demo_ScaleMatrix() As Drawing.Bitmap ' Zwei Datenvektoren erstellen Dim N As Integer = 100 Dim x(N) As Double, y(N) As Double For i As Integer = 0 To N x(i) = Rnd() * 10 - 1000 y(i) = Rnd() * 10000 - 50 Next i ' Eine Bitmap-Instanz erstellen Dim bmp As New Drawing.Bitmap(600, 400) ' Graphics-Objekt für Bitmap erstellen Dim g As Drawing.Graphics = Graphics.FromImage(bmp) ' Bitmap mit weisser Farbe füllen g.Clear(Color.White) ' Rechteck, in das die Daten eingepasst werden ' Hier wird noch keine Skalierung vorgenommen!! Dim pen As Drawing.Pen = Drawing.Pens.Red g.DrawRectangle(pen, 50, 20, bmp.Width - 100, bmp.Height - 40) ' Transformationsmatrix für Daten und ' Bitmap-Bereich erstellen und zuweisen ' (Extension Methods: Min, Max -> Extremwerte) g.Transform = ScaleMatrix(x.Min, x.Max - x.Min, _ y.Min, y.Max - y.Min, 50, bmp.Width - 100, 20, bmp.Height - 40) ' Zur Demo: Die Datenvektoren werden in ' ein Punkte-Array übertragen und transformiert ' (Damit wird die Wirkung der Matrix sichtbar) ' Dim pts() As PointF = Data2Points(x, y) ' g.Transform.TransformPoints(pts) ' Zur Demo: Auslesen der Elemente der Trafo-Matrix ' Dim el() As Single = g.Transform.Elements ' roten Pinsel erstellen Dim brush As Drawing.Brush = Drawing.Brushes.Red ' Größe des Datenpunktes (wird auch re-skaliert!) Dim pw As Single = CSng(Math.Abs(x.Max - x.Min) / 60) Dim ph As Single = CSng(Math.Abs(y.Max - y.Min) / 60) ' skalierte Werte in die Bitmap zeichnen ' (Datenpunkt-Ellipse dabei zentrieren) For i As Integer = 0 To N g.FillEllipse(brush, CSng(x(i)) - pw / 2, CSng(y(i)) - ph / 2, pw, ph) Next i ' Freigabe brush.Dispose() : g.Dispose() ' Rückgabe Return bmp End Function ''' <summary> ''' Übertragung von zwei Datenvektoren in ein ''' PointF-Array ''' </summary> ''' <param name="x">x-Vektor</param> ''' <param name="y">y-Vektor</param> ''' <returns>PointF-Array der Daten ''' (oder Nothing)</returns> Public Function Data2Points(ByVal x() As Double, _ ByVal y() As Double) As Drawing.PointF() ' Zunächst alles überprüfen If IsNothing(x) Or IsNothing(y) Then Return Nothing If UBound(x) <> UBound(y) Then Return Nothing Dim xug As Double = x.Min : Dim xog As Double = x.Max Dim yug As Double = y.Min : Dim yog As Double = y.Max ' Streuung der Daten gegeben? If (xog - xug) < 0.001 Then Return Nothing If (yog - yug) < 0.001 Then Return Nothing Dim pts(UBound(x)) As PointF For i As Integer = 0 To UBound(pts) ' IEEE-Sonderwerte können nicht gezeichnet werden If Double.IsNaN(x(i)) Then Return Nothing If Double.IsInfinity(x(i)) Then Return Nothing If Double.IsNaN(y(i)) Then Return Nothing If Double.IsInfinity(y(i)) Then Return Nothing ' Punkte erstellen pts(i).X = CSng(x(i)) pts(i).Y = CSng(y(i)) Next i Return pts End Function Dieser Tipp wurde bereits 13.062 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. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. 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 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |