vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Grafik und Font · Sonstiges   |   VB-Versionen: VB4, VB5, VB611.01.05
Kreisdiagramme mit VB-Boardmitteln

Anzeigen von Kreis-, Torten-, Scheibengrafiken mit reinen VB-Boardmitteln

Autor:   Thomas GollmerBewertung:     [ Jetzt bewerten ]Views:  8.686 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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 8.686 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!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.
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    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.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel