Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0780: Diagramme skalieren mit dem Scale-Befehl

 von 

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:

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [4,38 KB]

'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-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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.