Rubrik: Grafik und Font · Sonstiges | VB-Versionen: VB4, VB5, VB6 | 11.01.05 |
Kreisdiagramme mit VB-Boardmitteln Anzeigen von Kreis-, Torten-, Scheibengrafiken mit reinen VB-Boardmitteln | ||
Autor: Thomas Gollmer | Bewertung: | Views: 13.044 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Für kleine Projekte, bei denen das Einbinden von MSChart & Co. überflüssig erscheint, kann man sich mit diesem Code fix ein Kreisdiagramm anzeigen lassen.
Verschiedene Einstellungen beeinflussen das Aussehen. Vom normalen Kreis über eine Torte bis zu übereinander geschichteten Kreisscheiben kann das Erscheinungsbild variabel angepaßt werden.
Hier nun der Code:
Private Sub Torte_Zeichnen( _ Ein_Werte() As Integer, _ Kreis_Farben() As Long, _ Kreis_Größe As Integer, _ Kreis_Mitte_X As Integer, _ Kreis_Mitte_Y As Integer, _ Start_Position As Integer, _ Ein_Name() As String, _ Legende_X As Integer, _ Legende_Y As Integer, _ Legende_Farbe As Long, _ Legende_Anzahl_Zeigen As Boolean, _ Aufsteigend As Boolean, _ Ellipse As Single, _ Höhe As Integer, _ Abstand As Integer, _ Farbe_3D As Long, _ Ringe As Boolean, _ Zeichen_Obj As Object) ' Werte die Übergeben werden müssen ' X und Y Positionen immer in Pixeln ' 1. Variablenfeld der Anzahlen ' 2. Variablenfeld der Farben ' 3. Größe des Kreises ' 4. Startposition des ersten Eintages 0 bis 360 Grad ' Bei 0 beginnt das erste Tortenstück rechts ' Bei 90 beginnt das erste Tortenstück oben ' Bei 180 beginnt das erste Tortenstück links ' Bei 270 beginnt das erste Tortenstück unten ' 5. X Position Mitte des Kreises ' 6. Y Position Mitte des Kreises ' 7. Variablenfeld der Bezeichnungen ' 8. X Position der Legende ' 9. Y Position der Legende ' 10. die Farbe der Schrift der Legende ' 11. Ein True wenn die Anzahl in der Legende stehen soll, wenn nicht ein False ' 12. Ein True wenn die Ordnung der Legende aufsteigend ist sonst False ' 13. Seitenverhältniss der Ellipse/ des Kreises (0-1) ' 14. Höhe der Torte ' 15. Abstand äußeren Ringe ' 16. Farbe der aüßeren Ringe ' 17. True wenn die Ringe gemalt werden sollen, wenn nicht Flase ' 18. das Steuerelement auf das gezeichnet werden soll. Eine Form oder PictureBox Const Pi = 3.14159265358979 Dim Werte_Gesamt As Long Dim zähler As Long Dim Hilfszähler As Integer Dim Temp As Double Dim Gesamt_Winkel As Double Dim Filmanzahl() As Double Dim Temp_Name As String Dim Temp_Zahl As Double Dim Werte() As Double Dim Legende_Bezeichner() As String Dim Text_Anzahl As String ' Mit der Schrift "Courier New" erfolgt die Ausgabe der Legende ' schön untereinander Zeichen_Obj.ScaleMode = 3 Zeichen_Obj.Font = "Courier New" Hilfszähler = 0 ' Wenn die Summe der übergebenen Werte = 0 dann verlassen ohne Grafikaufbau For zähler = LBound(Ein_Werte()) To UBound(Ein_Werte()) Hilfszähler = Hilfszähler + Ein_Werte(zähler) Next zähler If Hilfszähler = 0 Then Exit Sub ' Erst mal das übergebene Variablenfeld ordnen ' zu erst die Max bis hin zum Min For Hilfszähler = 0 To (UBound(Ein_Werte())) + 1 For zähler = 1 To UBound(Ein_Werte()) ' wenn erster Eintrag kleiner tauschen sonst nicht If Ein_Werte(zähler - 1) < Ein_Werte(zähler) Then Temp_Zahl = Ein_Werte(zähler - 1) Temp_Name = Ein_Name(zähler - 1) Ein_Werte(zähler - 1) = Ein_Werte(zähler) Ein_Name(zähler - 1) = Ein_Name(zähler) Ein_Werte(zähler) = Temp_Zahl Ein_Name(zähler) = Temp_Name End If Next zähler Next Hilfszähler ' Felder, deren Wert = 0 ist entfernen und nicht mit anzeigen Hilfszähler = 0 For zähler = LBound(Ein_Werte()) To UBound(Ein_Werte()) If Ein_Werte(zähler) = 0 Then Exit For Hilfszähler = Hilfszähler + 1 Next zähler ReDim Werte(Hilfszähler - 1) ReDim Legende_Bezeichner(Hilfszähler - 1) ' Nachbearbeitete Werte in neues Variablenfeld schieben For zähler = LBound(Ein_Werte()) To UBound(Ein_Werte()) If Ein_Werte(zähler) = 0 Then Exit For Werte(zähler) = Ein_Werte(zähler) Legende_Bezeichner(zähler) = Ein_Name(zähler) Next zähler ReDim Filmanzahl(UBound(Werte())) For zähler = LBound(Werte()) To UBound(Werte()) Filmanzahl(zähler) = Werte(zähler) Next zähler ' alle Werte des übergebenen Feldes zusammenrechnen For zähler = LBound(Werte()) To UBound(Werte()) Werte_Gesamt = Werte_Gesamt + Werte(zähler) Next zähler ' Tortenstückgroße berechnen For zähler = LBound(Werte()) To UBound(Werte()) Gesamt_Winkel = Gesamt_Winkel + Werte(zähler) Temp = Gesamt_Winkel / Werte_Gesamt * 360 ' zum Winkel die Startposition dazurechnen Temp = Temp + Start_Position If Temp > 360 Then Temp = Temp - 360 ' umrechnen ins Bogenmaß Temp = Temp * Pi / 180 Werte(zähler) = Temp Next zähler ' Jetzt den Kreis / die Ellipse in mehreren Schichten ' zeichnen (Scheiben-Effekt) Zeichen_Obj.DrawWidth = 1 Zeichen_Obj.DrawStyle = 0 For Hilfszähler = Kreis_Mitte_Y + Höhe To Kreis_Mitte_Y Step -Abstand Zeichen_Obj.FillStyle = 0 For zähler = LBound(Werte()) To (UBound(Werte())) - 1 Zeichen_Obj.FillColor = Kreis_Farben(zähler + 1) Zeichen_Obj.ForeColor = Kreis_Farben(zähler + 1) Zeichen_Obj.Circle (Kreis_Mitte_X, Hilfszähler), _ Kreis_Größe, , -Werte(zähler), -Werte(zähler + 1), Ellipse Next zähler ' Erstes Stück malen Zeichen_Obj.ForeColor = Kreis_Farben(LBound(Kreis_Farben())) Zeichen_Obj.FillColor = Kreis_Farben(LBound(Kreis_Farben())) Zeichen_Obj.Circle (Kreis_Mitte_X, Hilfszähler), _ Kreis_Größe, , -Werte(UBound(Werte)), -Werte(LBound(Werte)), Ellipse ' Jetzt einen Ring um die Schicht malen If Ringe = True Then Zeichen_Obj.ForeColor = Farbe_3D Zeichen_Obj.FillColor = Farbe_3D Zeichen_Obj.FillStyle = 1 Zeichen_Obj.Circle (Kreis_Mitte_X, Hilfszähler), Kreis_Größe, , , , Ellipse End If Next Hilfszähler ' an die Vorgegebene Position die Legende zeichnen Zeichen_Obj.DrawWidth = 5 ' Wenn die Legende vom Max nach Min angezeigt werden soll If Aufsteigend = False Then For zähler = LBound(Legende_Bezeichner()) To UBound(Legende_Bezeichner()) Zeichen_Obj.CurrentX = Legende_X Zeichen_Obj.CurrentY = zähler * 14 + Legende_Y Zeichen_Obj.ForeColor = Kreis_Farben(zähler) Zeichen_Obj.Line (Zeichen_Obj.CurrentX, Zeichen_Obj.CurrentY)- _ (Zeichen_Obj.CurrentX + 10, Zeichen_Obj.CurrentY) Zeichen_Obj.CurrentY = Zeichen_Obj.CurrentY - 7 Zeichen_Obj.ForeColor = Legende_Farbe ' Wenn gewünscht Anzahl in die Legende schreiben sonst nicht If Legende_Anzahl_Zeigen = False Then Zeichen_Obj.Print " " & Legende_Bezeichner(zähler) End If If Legende_Anzahl_Zeigen = True Then If Len(CStr(Filmanzahl(zähler))) = 1 Then Text_Anzahl = " " & CStr(Filmanzahl(zähler)) End If If Len(CStr(Filmanzahl(zähler))) = 2 Then Text_Anzahl = " " & CStr(Filmanzahl(zähler)) End If If Len(CStr(Filmanzahl(zähler))) = 3 Then Text_Anzahl = " " & CStr(Filmanzahl(zähler)) End If Zeichen_Obj.Print " " & Text_Anzahl & " " & Legende_Bezeichner(zähler) End If Next zähler ' Wenn die Legende von Min nach Max angezeigt werden soll Else For zähler = UBound(Legende_Bezeichner()) To LBound(Legende_Bezeichner()) Step -1 Zeichen_Obj.CurrentX = Legende_X Zeichen_Obj.CurrentY = (UBound(Legende_Bezeichner()) - zähler * 14 + _ Legende_Y) + UBound(Legende_Bezeichner) * 13 Zeichen_Obj.ForeColor = Kreis_Farben(zähler) Zeichen_Obj.Line (Zeichen_Obj.CurrentX, Zeichen_Obj.CurrentY)- _ (Zeichen_Obj.CurrentX + 10, Zeichen_Obj.CurrentY) Zeichen_Obj.CurrentY = Zeichen_Obj.CurrentY - 7 Zeichen_Obj.ForeColor = Legende_Farbe ' Wenn gewünscht Anzahl in die Legende schreiben sonst nicht If Legende_Anzahl_Zeigen = False Then Zeichen_Obj.Print " " & Legende_Bezeichner(zähler) End If If Legende_Anzahl_Zeigen = True Then If Len(CStr(Filmanzahl(zähler))) = 1 Then Text_Anzahl = " " & CStr(Filmanzahl(zähler)) End If If Len(CStr(Filmanzahl(zähler))) = 2 Then Text_Anzahl = " " & CStr(Filmanzahl(zähler)) End If If Len(CStr(Filmanzahl(zähler))) = 3 Then Text_Anzahl = " " & CStr(Filmanzahl(zähler)) End If Zeichen_Obj.Print " " & Text_Anzahl & " " & Legende_Bezeichner(zähler) End If Next zähler End If End Sub
Ein kleines Anwendungsbeispiel
Private Sub Form_Load() Dim Verbrauch(11) As Integer Dim Farben(11) As Long Dim Bezeichner(11) As String ' Eigenschaften des Ausgabeobjekts festlegen Me.AutoRedraw = True Me.Width = 8655 Me.Height = 5700 Me.Print "" Me.Print " Bierverbrauch in Flaschen:" ' Legende Bezeichner(0) = "Jan.": Bezeichner(1) = "Feb.": Bezeichner(2) = "März" Bezeichner(3) = "Apr.": Bezeichner(4) = "Mai": Bezeichner(5) = "Juni" Bezeichner(6) = "Juli": Bezeichner(7) = "Aug.": Bezeichner(8) = "Sep." Bezeichner(9) = "Okt.": Bezeichner(10) = "Nov.": Bezeichner(11) = "Dez." ' Werte Verbrauch(0) = 100: Verbrauch(1) = 120: Verbrauch(2) = 90: Verbrauch(3) = 75 Verbrauch(4) = 120: Verbrauch(5) = 140: Verbrauch(6) = 145: Verbrauch(7) = 160 Verbrauch(8) = 130: Verbrauch(9) = 100: Verbrauch(10) = 90: Verbrauch(11) = 140 ' Farben Farben(0) = vbBlack: Farben(1) = vbBlue: Farben(2) = vbCyan Farben(3) = vbGreen: Farben(4) = vbMagenta: Farben(5) = vbRed Farben(6) = vbWhite: Farben(7) = vbYellow: Farben(8) = &HC0C0FF Farben(9) = &HFFC0C0: Farben(10) = &H80FF&: Farben(11) = &H8000& ' Tortendiagramm zeichnen Torte_Zeichnen Verbrauch(), Farben(), 220, 240, 150, 70, Bezeichner(), _ 480, 20, vbBlack, True, True, 0.4, 80, 2, &H808080, True, Me End Sub