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 Dieser Tipp wurde bereits 13.018 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
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. |