VB 5/6-Tipp 0780: Diagramme skalieren mit dem Scale-Befehl
von Klaus Langbein
Beschreibung
Kurven zu zeichnen ist mit den Standardfunktionen Line und Pset recht einfach. Es müssen jedoch meist Skalierungsfaktoren und eine Ortsverschiebung, also eine Koordinatentransformation vorgenommen werden. VB bietet hierfür die Scale-Funktion, mit deren Hilfe benutzerdefinierte Skalen eingestellt werden können. Mit Hilfe des Scale-Befehls kann auch die Richtung der Y-Achse so eingestellt werden, dass positive Werte entsprechend dem kartesischen Koordinatensystem nach oben und nicht wie in der Default-Einstellung von oben nach unten verlaufen.
Benötigt man neben dem Diagramm Ränder für eine Beschriftung, so muß dies im Scale-Befehl berücksichtigt werden. Im vorliegenden Beispiel wird die Skalierung so berechnet, dass feste Ränder in Einheiten von Pixeln oder Twipps unabhängig von der Größe und Skalierung des Diagramms vorgegeben werden können.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode 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! '----------- Anfang Projektdatei PrjDiagram1.vbp ----------- '--- Anfang Formular "frmDiagram1" alias frmDiagram1.frm --- ' Steuerelement: Schaltfläche "cmdSimple" ' Steuerelement: Schaltfläche "cmdDraw" ' Steuerelement: Bildfeld-Steuerelement "Picture1" ' ' Kurven zu zeichnen ist mit den Standardfunktionen Line und Pset ' recht einfach. Es müssen jedoch meist Skalierungsfaktoren ' und eine Ortsverschiebung, also eine Koordinatentransformation ' vorgenommen werden. VB bietet hierfür die Scale-Funktion, ' mit deren Hilfe benutzerdefinierte Skalen eingestellt werden können. ' Mit Hilfe des Scale-Befehls kann auch die Richtung der Y-Achse ' so eingestellt werden, dass positive Werte entsprechend dem ' kartesischen Koordinatensystem nach oben und nicht wie in der ' Default-Einstellung von oben nach unten verlaufen. ' Benötigt man neben dem Diagramm Ränder für eine Beschriftung, so ' muß dies im Scale-Befehl berüchsichtigt werden. Im vorliegenden Beispiel ' wird die Skalierung so berechnet, dass feste Ränder in Einheiten von ' Pixeln oder Twipps unabhängig von der Größe und Skalierung des ' Diagramms vorgegeben werden können. ' 'Option Explicit ' Nur für Nerds Dim xMax As Double ' Maximalwerte, die im Diagramm möglich sein sollen Dim xMin As Double Dim yMax As Double Dim yMin As Double ' Dim sxMax As Double ' Maximalwerte inklusive Ränder Dim sxMin As Double Dim syMax As Double Dim syMin As Double ' Dim MarginLeft As Long ' Ränder in Bildschirmeinheiten (Pixel, Twipps) Dim MarginTop As Long Dim MarginRight As Long Dim MarginBottom As Long ' Dim xFact As Double Dim yFact As Double Dim x As Double Dim y As Double Function DrawGridY(ByVal yStep As Double) As Long Dim Grey As Long Dim yStart As Double Grey = 220 Picture1.ForeColor = RGB(Grey, Grey, Grey) yStep = Abs(yStep) If yStep = 0 Then Exit Function End If ' Sonderbehandlung für den Fall, dass die Kurve nicht bei y = 0 anfängt If Sgn(yMin) = 1 And Sgn(yMax) = 1 Then yStart = yMin Else yStart = 0 End If ' Die Gitterlinien werden jeweils von der Achse nach außen gezeichnet ' für den Fall, dass die letzte Linie nicht am Maximalwert liegt. ' Ausgabe der horizontalen Gitterlinien For y = yStart To (yMax) Step yStep Picture1.Line (xMin, y)-(xMax, y) Next y ' Sonderbehandlung wenn ymax und ymin negativ sind If Sgn(yMin) = -1 And Sgn(yMax) = -1 Then yStart = yMax Else yStart = 0 End If For y = yStart To (yMin) Step -yStep Picture1.Line (xMin, y)-(xMax, y) Next y End Function Function DrawGridX(ByVal xStep As Double) As Long Dim Grey As Long Dim xStart As Double Grey = 220 Picture1.ForeColor = RGB(Grey, Grey, Grey) xStep = Abs(xStep) If xStep = 0 Then Exit Function End If ' Sonderbehandlung für den Fall, dass die Kurve nicht bei x = 0 anfängt If Sgn(xMin) = 1 And Sgn(xMax) = 1 Then xStart = xMin Else xStart = 0 End If ' Wir zeichnen das Gitter von der Achse nach außen für den Fall ' dass die letzte Linie nicht auf dem Maximalwert liegt For x = xStart To (xMax) Step xStep Picture1.Line (x, yMax)-(x, yMin) Next x ' Sonderbehandlung wenn xmax und xmin negativ sind If Sgn(xMin) = -1 And Sgn(xMax) = -1 Then xStart = xMax Else xStart = 0 End If For x = xStart To (xMin) Step -xStep Picture1.Line (x, yMax)-(x, yMin) Next x End Function Function DrawAxis(ByVal DrawFrame As Boolean) As Long Dim Grey As Long Grey = 120 Picture1.ForeColor = RGB(Grey, Grey, Grey) ' Achsen und Rahmen zeichen Picture1.Line (xMin, 0)-(xMax, 0) Picture1.Line (0, yMax)-(0, yMin) If DrawFrame = True Then Picture1.ForeColor = 0 Picture1.Line (xMin, yMax)-(xMax, yMin), , B End If End Function Function Fact() As Long ' Die Variablen xMax, yMax, Margin etc werden nicht an die ' Funktion Fact übergeben, weil sie Formweit benötigt werden ' Festlegen der Maximalwerte xMax = 4 xMin = -4 yMax = 1.2 yMin = -1.2 ' Festlegen der Ränder in den aktuellen Einheiten (Pixel, Twipps) MarginLeft = 40 MarginTop = 40 MarginRight = 20 MarginBottom = 60 ' Umrechnungsfaktoren bestimmen xFact = (Picture1.ScaleWidth - MarginLeft - MarginRight) / (xMax - xMin) yFact = (Picture1.ScaleHeight - MarginTop - MarginBottom) / (yMax - yMin) ' Für die Einstellung der Skala benötigte Maximalwerte sxMin = xMin - MarginLeft / xFact syMax = yMax + MarginTop / yFact sxMax = xMax + MarginRight / xFact syMin = yMin - MarginBottom / yFact End Function Function Legend(ByVal LegendX$, ByVal LegendY$, ByVal Title$) As Long Dim Text$ Dim cnt As Long Dim tw As Double Dim th As Double Picture1.ForeColor = 0 Picture1.FontName = "Arial" Picture1.FontSize = 12 Picture1.FontBold = False Text$ = Title tw = Picture1.TextWidth(Text) ' cnt = 0 Do If tw > (xMax - xMin) * 1.1 Then Picture1.FontSize = Picture1.FontSize - 0.5 tw = Picture1.TextWidth(Text) cnt = cnt + 1 Else Exit Do End If Loop Until Picture1.FontSize < 3 Or cnt > 20 th = Picture1.TextHeight(Text) Picture1.CurrentX = xMin + (xMax - xMin) / 2 - tw / 2 Picture1.CurrentY = yMax - th + (10 / yFact) Picture1.Print Text$ ' Picture1.FontName = "Arial" Picture1.FontSize = 11 Picture1.FontBold = True Text$ = LegendX$ tw = Picture1.TextWidth(Text) Picture1.CurrentX = xMin + (xMax - xMin) / 2 - tw / 2 Picture1.CurrentY = yMin - (5 / yFact) Picture1.Print Text$; Picture1.FontName = "Wingdings 3" ' "Symbol" Picture1.FontSize = 12 Picture1.FontBold = False Picture1.CurrentY = yMin - (4 / yFact) Picture1.CurrentX = Picture1.CurrentX + (5 / xFact) Text$ = Chr$(143) ' 174 für Symbol Picture1.Print Text$ Picture1.FontName = "Arial" Picture1.FontSize = 11 Picture1.FontBold = True Text$ = LegendY$ Picture1.CurrentX = xMin - (20 / xFact) Picture1.CurrentY = 10 / yFact Picture1.Print Text$ Picture1.FontName = "Wingdings 3" Picture1.FontSize = 14 Picture1.FontBold = False Picture1.CurrentY = 30 / yFact Picture1.CurrentX = xMin - (21 / xFact) Text$ = Chr$(143) Picture1.Print Text$ End Function 'Meßlatte: '2345678901234567890123456789012345678901234567890123456789012345678901234567890 Function Plot() As Long Dim xStep As Double Dim n As Long Dim x As Double Dim y As Double Picture1.ScaleMode = 3 Call Fact ' Maßstab einstellen Picture1.Scale (sxMin, syMax)-(sxMax, syMin) ' Zeichnung vorbereiten Picture1.Cls Call DrawGridY(yMax / 6) Call DrawGridX(xMax / 4) Call DrawAxis(True) ' Nun die Kurve vorbereiten Picture1.ForeColor = vbBlue n = 1000 ' Anzahl der Punkte festlegen xStep = (xMax - xMin) / n ' Schrittweite berechnen ' Den 1. Punkt setzen x = xMin y = 2 * Sin(x) * Exp(-x ^ 2) Picture1.PSet (x, y) ' Jetzt die eigentliche Kurve zeichnen For x = xMin To xMax Step xStep y = 1 * Sin(10 * x) * Exp(-x ^ 2) Picture1.Line -(x, y) Next x Call Legend("x (µm)", "y", "Gauß'sche Glockenkurve durch Sinus moduliert") End Function Function SimplePlot(Pic As Object) As Long ' In dieser Funktion wurde die Methode auf ein Minimum reduziert. ' Sie zeigt, welche Schritte mindestens benötigt werden, um eine ' Kurve und Achsen zu zeichnen. Die Funktion ist selbstkonsistent ' und kann einfach per Cut/Paste in andere Projekte übernommen werden. Dim xMax As Double Dim xMin As Double Dim yMax As Double Dim yMin As Double Dim xStep As Double Dim n As Long Dim Grey As Long Dim sm As Long sm = Pic.ScaleMode xMax = 4 xMin = -4 yMax = 1 yMin = -1 ' Maßstab einstellen Pic.Scale (xMin * 1.2, yMax * 1.2)-(xMax * 1.2, yMin * 1.2) Pic.Cls ' Achsen und Rahmen zeichen Grey = 120 Pic.ForeColor = RGB(Grey, Grey, Grey) Pic.Line (xMin, 0)-(xMax, 0) Pic.Line (0, yMax)-(0, yMin) Pic.ForeColor = 0 Pic.Line (xMin, yMax)-(xMax, yMin), , B ' Kurve vorbereiten n = 1000 ' Anzahl der Punkte xStep = (xMax - xMin) / n ' Schrittweite berechnen Pic.ForeColor = vbBlue Pic.PSet (xMin, 0) ' Den 1. Punkt setzen ' Jetzt die eigentliche Kurve zeichnen For x = xMin To xMax Step xStep y = 0.9 * Sin(10 * x) * Exp(-x ^ 2) Pic.Line -(x, y) Next x Pic.ScaleMode = sm End Function Private Sub cmdDraw_Click() Call Plot End Sub Private Sub cmdSimple_Click() SimplePlot Picture1 End Sub Private Sub Form_Load() cmdDraw.Move 90, 60 cmdSimple.Move cmdDraw.Left + cmdDraw.Width, 60 cmdDraw.Caption = "Draw" cmdSimple.Caption = "Simple" Picture1.AutoRedraw = True Picture1.BackColor = vbWhite Picture1.ScaleMode = 3 Picture1.Move 90, 450 End Sub Private Sub Form_Resize() With Picture1 .Move .Left, .Top, ScaleWidth - 2 * .Left, ScaleHeight - .Top - .Left End With Call Plot End Sub '---- Ende Formular "frmDiagram1" alias frmDiagram1.frm ---- '------------ Ende Projektdatei PrjDiagram1.vbp ------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.