VB 5/6-Tipp 0781: Diagramme mit eigener Skalierung
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. Übernimmt man die Skalierung jedoch selbst in eigenen Funktionen hat man einen größeren Gestaltungsspielraum und man ist Herr der Lage. Gerechnet wird mit x und y in den vorgegebenen Grenzen und vor der Ausgabe wird die Transformation in 2 kurzen Funktionen durchgeführt. Vorteile sind, dass man ohne Scalemode zu wechseln, die Positionierung der Schrift im eingestellten Scalemode (z.B. Pixel) vornehmen kann, während die Kurve in weltlichen Einheiten bearbeitet werden kann. Des Weiteren hat man die Möglichkeit die Ausgabe schnell auf API-Methoden umzustellen.
Benötigt man neben dem Diagramm Ränder für eine Beschriftung, so muß dies bei Einstellung der Faktoren 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. Zusätzlich kann das Diagramm auf dem Ausgabegerät (Drucker) oder auf einer Picturebox oder Form beliebig positioniert werden.
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 PrjDiagram2.vbp ----------- '--- Anfang Formular "frmDiagram2" alias frmDiagram2.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. ' Übernimmt man die Skalierung jedoch selbst in eigenen Funktionen ' hat man einen größeren Gestaltungsspielraum und man ist Herr der Lage. ' Gerechnet wird mit x und y in den vorgegebenen Grenzen und vor der ' Ausgabe wird die Transformation in 2 kurzen Funktionen durchgeführt. ' Vorteile sind, dass man ohne Scalemode zu wechseln, die Positionierung ' der Schrift im eingestellten Scalemode (z.B. Pixel) vornehmen kann, ' während die Kurve in weltlichen Einheiten bearbeitet werden kann. ' Des Weiteren hat man die Möglichkeit die Ausgabe schnell auf ' API-Methoden umzustellen. ' ' Benötigt man neben dem Diagramm Ränder für eine Beschriftung, so ' muß dies bei Einstellung der Faktoren 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. Zusätzlich kann ' Das Diagramm auf dem Ausgabegerät (Drucker) oder auf einer Picturebox ' oder Form beliebig positioniert werden. ' ' 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 xOff As Double Dim yOff As Double Private Function Arrow90(ByVal Pic As Object, _ ByVal x1 As Double, _ ByVal y1 As Double, _ ByVal x2 As Double, _ ByVal y2 As Double, _ ByVal L As Double, _ ByVal Angle As Long) As Long Dim fs As Long fs = Pic.FillStyle Pic.FillStyle = 0 Pic.Line (x1, y1)-(x2, y2) Select Case Angle Case 0 Pic.Circle (x2, y2), L, , -2.836, -3.436 Case 90 Pic.Circle (x2, y2), L, , -4.398, -4.998 Case 180 Pic.Circle (x2, y2), L, , -5.979, -0.296 Case 270 Pic.Circle (x2, y2), L, , -1.275, -1.875 End Select Pic.FillStyle = fs End Function Function DrawBoundary(Obj As Object, _ ByVal Left As Double, _ ByVal Top As Double, _ ByVal Width As Double, _ ByVal Height As Double, _ ByVal Grey As Long) As Long Obj.ForeColor = RGB(Grey, Grey, Grey) Obj.Line (Left, Top)-(Left + Width, Top + Height), , B End Function Function DrawGridY(Obj As Object, ByVal yStep As Double) As Long Dim Grey As Long Dim yStart As Double Dim xxMin As Long Dim yyMin As Long Dim xxMax As Long Dim yy As Long Dim y As Double Grey = 220 Obj.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 xxMin = xxc(xMin) xxMax = xxc(xMax) For y = yStart To (yMax) Step yStep yy = yyc(y) Obj.Line (xxMin, yy)-(xxMax, yy) 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 yy = yyc(y) Obj.Line (xxMin, yy)-(xxMax, yy) Next y End Function Function DrawGridX(Obj As Object, ByVal xStep As Double) As Long Dim Grey As Long Dim xStart As Double Dim yyMax As Long Dim yyMin As Long Dim x As Double Dim xx As Long Grey = 220 Obj.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 yyMax = yyc(yMax) yyMin = yyc(yMin) For x = xStart To (xMax) Step xStep xx = xxc(x) Obj.Line (xx, yyMax)-(xx, yyMin) 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 xx = xxc(x) Obj.Line (xx, yyMax)-(xx, yyMin) Next x End Function Function DrawAxis(ByVal DrawFrame As Boolean) As Long Dim Grey As Long Dim xx1 As Long Dim xx2 As Long Dim yy1 As Long Dim yy2 As Long Grey = 120 Picture1.ForeColor = RGB(Grey, Grey, Grey) ' Achsen und Rahmen zeichen xx1 = xxc(xMin) xx2 = xxc(xMax) yy1 = yyc(yMin) yy2 = yyc(yMax) Picture1.Line (xx1, yOff)-(xx2, yOff) Picture1.Line (xOff, yy1)-(xOff, yy2) If DrawFrame = True Then Picture1.ForeColor = 0 Picture1.Line (xx1, yy1)-(xx2, yy2), , B End If End Function Function Fact(ByVal Left As Double, ByVal Top As Double, _ ByVal Width As Double, ByVal Height As Double) As Long ' Die Variablen xMax, yMax, Margin etc werden nicht an die ' Funktion Fact übergeben, weil sie Formweit benötigt werden ' Umrechnungsfaktoren bestimmen xFact = (Width - MarginLeft - MarginRight) / (xMax - xMin) yFact = (Height - MarginTop - MarginBottom) / (yMax - yMin) xOff = Left + MarginLeft + Abs(xMin) * xFact yOff = Top + MarginTop + Abs(yMax) * yFact yFact = -yFact ' Dies tun wir um die Skala umzukehren 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 Dim x As Double Dim y 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) * xFact 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 = xxc(xMin + (xMax - xMin) / 2) - tw / 2 Picture1.CurrentY = yyc(yMax) - th - 5 Picture1.Print Text$ ' Picture1.FontName = "Arial" Picture1.FontSize = 11 Picture1.FontBold = True Text$ = LegendX$ tw = Picture1.TextWidth(Text) Picture1.CurrentX = xxc(xMin + (xMax - xMin) / 2) - tw / 2 Picture1.CurrentY = yyc(yMin) + 5 Picture1.Print Text$; x = Picture1.CurrentX + 5 y = yyc(yMin) + 15 Arrow90 Picture1, x, y, x + 30, y, 6, 0 Picture1.FontName = "Arial" Picture1.FontSize = 11 Picture1.FontBold = True Text$ = LegendY$ tw = Picture1.TextWidth(Text) Picture1.CurrentX = xxc(xMin) - 20 Picture1.CurrentY = yyc(0) - 10 Picture1.Print Text$ x = xxc(xMin) - 20 + tw / 2 y = yyc(0) - 10 Arrow90 Picture1, x, y, x, y - 30, 6, 90 End Function 'Meßlatte: '2345678901234567890123456789012345678901234567890123456789012345678901234567890 Function Plot(Obj As Object) As Long Dim xStep As Double Dim n As Long Dim x As Double Dim y As Double Dim i As Long Dim j As Long Dim a As Double Dim b As Double Dim Phi As Double Dim Pi As Double Dim DiagLeft As Long Dim DiagTop As Long Dim DiagWidth As Long Dim DiagHeight As Long Obj.ScaleMode = 3 ' Festlegen der Position und Größe des gesamten Diagramms auf dem ' Ausgabegerät (z.B. Picturbox). Einheiten sind Pixel oder die aktuellen ' Einstellungen des DC. Das Diagramm kann so z.B. auf einem ' Din A4-Blatt positioniert werden. Falls das Diagramm sich auf die ' Grenzen der Picturebox beziehen soll, werden DiagLeft und DiagTop ' = 0 gesetzt, während DiagWidh und DiagHeight auf ScaleWidth und ' Scaleheight gestellt werden. DiagLeft = 10 DiagTop = 10 DiagWidth = Obj.ScaleWidth - DiagLeft - 10 DiagHeight = Obj.ScaleHeight - DiagTop - 10 ' Festlegen der Ränder innerhalb des Diagramms. Einheiten sind ' ebenfalls noch die voreingestellten Einheiten (Scalemode) des Objekts. MarginLeft = 40 MarginTop = 40 MarginRight = 10 MarginBottom = 30 ' Festlegen der Maximalwerte. Einheiten sind hier die geräteunabhängigen ' Einheiten des Diagramms (z.B. m, km, kg, Anzahl, usw.). xMax = 2.4 xMin = -2.4 yMax = 1.2 yMin = -1.2 ' Faktoren und Offsets berechnen Call Fact(DiagLeft, DiagTop, DiagWidth, DiagHeight) ' Zeichnung vorbereiten Obj.Cls ' Zunächs die Grenzen des Diagramms einzeichnen. Dies dient nur ' zur Kontrolle und kann später weggelassen werden. Call DrawBoundary(Obj, DiagLeft, DiagTop, DiagWidth, DiagHeight, 200) ' Gitter, Achsen und Rahmen der Zeichenfläche ausgeben Call DrawGridY(Obj, yMax / 6) Call DrawGridX(Obj, xMax / 6) Call DrawAxis(True) ' Kurve vorbereiten Obj.ForeColor = vbBlue n = 1000 ' Anzahl der Punkte festlegen 'xStep = (xMax - xMin) / n ' Schrittweite berechnen a = 1 b = 1 ' auchmal 4,5,6,8,15,32,33 einsetzen Pi = 4 * Atn(1) For Phi = 0 To 2 * Pi Step (2 * Pi / n) x = (a + a * Cos(8 * Phi) ^ 2) * Sin(b * Phi) y = a * Cos(8 * Phi) * Cos(b * Phi) If cnt = 0 Then Obj.PSet (xxc(x), yyc(y)) Else Obj.Line -(xxc(x), yyc(y)) End If cnt = cnt + 1 Next Phi Call Legend("x (mm)", "y", "Die Bananengleichung - schwer zu verstehen, was?") End Function Function xxc(ByVal x As Double) As Long xxc = xOff + xFact * x End Function Function yyc(ByVal y As Double) As Long yyc = yOff + yFact * y End Function Private Sub cmdDraw_Click() Call Plot(Picture1) End Sub Private Sub cmdSimple_Click() Unload Me frmSimple2.Show 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(Picture1) End Sub '---- Ende Formular "frmDiagram2" alias frmDiagram2.frm ---- '---- Anfang Formular "frmSimple2" alias frmSimple2.frm ---- ' Steuerelement: Schaltfläche "cmdDraw" ' Steuerelement: Schaltfläche "cmdMore" ' Steuerelement: Bildfeld-Steuerelement "Picture1" 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 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 xOff As Double Dim yOff As Double Dim x As Double Dim y As Double ' Dim xStep As Double Dim n As Long Dim Grey As Long Dim sm As Long sm = Pic.ScaleMode ' Scalemode zwischenspeichern Picture1.ScaleMode = 3 ' Festlegen der Ränder in den aktuellen Einheiten. Es können entweder ' feste Werte, z.B. 40 Pixel oder ein Prozentsatz der ScaleWidth oder ' ScaleHeight angegeben werden MarginLeft = 40 ' Oder Pic.ScaleWidth * 0.1 MarginTop = 40 ' Oder Pic.ScaleHeight * 0.1 MarginRight = 20 MarginBottom = 30 ' Festlegen der Maximalwerte xMax = 5 xMin = -5 yMax = 1.2 yMin = -1.2 ' xFact = (Picture1.ScaleWidth - MarginLeft - MarginRight) / (xMax - xMin) yFact = (Picture1.ScaleHeight - MarginTop - MarginBottom) / (yMax - yMin) yFact = -yFact ' Dies tun wir um die Skala umzukehren xOff = MarginLeft + Abs(xMin) * xFact yOff = MarginTop - Abs(yMax) * yFact Pic.Cls ' Achsen und Rahmen zeichen Grey = 120 Pic.ForeColor = RGB(Grey, Grey, Grey) Pic.Line (xOff + xFact * xMin, yOff)-(xOff + xFact * xMax, yOff) Pic.Line (xOff, yOff + yFact * yMax)-(xOff, yOff + yFact * yMin) Pic.ForeColor = 0 Pic.Line (xOff + xFact * xMin, yOff + yFact * yMax)- _ (xOff + xFact * xMax, yOff + yFact * yMin), , B ' Kurve vorbereiten n = 1000 ' Anzahl der Punkte xStep = (xMax - xMin) / n ' Schrittweite berechnen Pic.ForeColor = vbBlue x = xMin y = 0 Pic.PSet (xOff + xFact * x, yOff + yFact * y) ' Den 1. Punkt setzen ' Jetzt die eigentliche Kurve zeichnen For x = xMin To xMax Step xStep y = 0 For i = 1 To 10 y = y + Sin(i * x ^ 2) Next i y = y / 10 Pic.Line -(xOff + xFact * x, yOff + yFact * y) Next x Pic.ScaleMode = sm End Function Private Sub cmdDraw_Click() SimplePlot Picture1 End Sub Private Sub cmdMore_Click() Unload Me frmDiagram2.Show End Sub Private Sub Form_Load() cmdDraw.Move 90, 60 cmdMore.Move cmdDraw.Left + cmdDraw.Width, 60 cmdDraw.Caption = "Draw" cmdMore.Caption = "Advanced" 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 SimplePlot(Picture1) End Sub '----- Ende Formular "frmSimple2" alias frmSimple2.frm ----- '------------ Ende Projektdatei PrjDiagram2.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.