In Ergänzung meines Tipps Als Parameter sind nicht nur einzelne Datenserien angebbar, sondern Felder von Serien. Die Prozedur: ''' <summary> ''' Paralleles Animieren von Serien in Charts ''' </summary> ''' <param name="theChart">die Chart</param> ''' <param name="theSeries">die zu animierenden Serien (Feld)</param> ''' <param name="anzXValues">die Anzahl der XValues</param> ''' <param name="theSteps">die Schrittweiten der YValues (Feld)</param> ''' <param name="xvField">das Feld der Felder mit den XValues</param> ''' <param name="yvField">das Feld der Felder mit den YValues</param> ''' <param name="pSec">die Zeitspanne für die Pause während der Animation</param> ''' <param name="animArt">die Animationsart (0..einzelnes oder 1..gleichzeitiges Wachsen</param> ''' <param name="direction">die Richtung der Animation (0..von links, 1..von rechts</param> ''' <param name="clearing">sollen die Serienpunkte gelöscht werden, ja|nein</param> ''' <param name="labeling">Labels für YValues zeigen, ja|nein. ''' Wenn ja, muss Labelformat vorgegeben werden.</param> Public Sub AnimateSomeSeries(theChart As Chart, theSeries() As Object, anzXValues As Short, _ theSteps() As Object, xvField() As Object, yvField() As Object, inField() As Object, _ pSec As Single, Optional animArt As Short = 0, _ Optional direction As Short = 0, _ Optional clearing As Boolean = False, _ Optional labeling() As String = Nothing) Dim anfang, ende, schritt, i, j As Short anfang = 0 : schritt = 1 : ende = anzXValues - 1 If direction = 1 Then ' Animation von rechts beginnend anfang = anzXValues - 1 : ende = 0 : schritt = -1 End If Dim ser As Series Dim w As Boolean Dim anzSeries As Short = theSeries.Length ' temporäre Felder Dim iniFields(anzSeries - 1) As Array ' Initialisierungsfeld Dim xdvFields(anzSeries - 1) As Array ' XValuesfeld Dim ydvFields(anzSeries - 1) As Array ' YValuesfeld Dim dmaxS(anzSeries - 1) As Array ' Maximalwerte erreicht Dim yTypes(anzSeries - 1) As Type ' Feld für Datentypen YValues ' die Felder mit Daten aus Parameterfeldern füllen For i = 0 To anzSeries - 1 iniFields(i) = inField(i) xdvFields(i) = xvField(i) ydvFields(i) = yvField(i) yTypes(i) = yvField(i)(0).GetType dmaxS(i) = Array.CreateInstance(GetType(Short), anzXValues) ' für art>0 Next With theChart ' die Animation ausführen für alle XValues ' Art: einen Datapoint nach dem anderen gemäß der XValues-Reihenfolge animieren ' (gemeinsames Wachsen) If clearing Then For i = 0 To anzSeries - 1 ' Series.Points löschen ser = theSeries(i) ser.Points.Clear() ' Series.Points mit den aktuellen Xvalues und den YValues=0 verbinden ser.Points.DataBindXY(xdvFields(i), iniFields(i)) ' Chart updaten .Update() Next End If Dim iField, xField, yField As Array Dim dmax(anzSeries - 1) As Short ' Feld für Registrieren, ob Endpunkte erreicht If animArt = 0 Then For i = anfang To ende Step schritt ReDim dmax(anzSeries - 1) Do xField = xdvFields(j) yField = ydvFields(j) iField = iniFields(j) If dmax(j) = 0 Then iField(i) += theSteps(j) ' ersten Wert setzen If theSteps(j) < 0 Then w = (iField(i) + theSteps(j) <= yField(i)) Else w = (iField(i) + theSteps(j) >= yField(i)) End If If w Then dmax(j) += 1 ' dmax-Wert erhöhen, wenn maximaler YValue des Datapoint erreicht iField(i) = yField(i) Else dmax(j) = 0 End If ' Series.Points nun mit Null-YValue-Feld verbinden ser = theSeries(j) ser.Points.DataBindXY(xField, iField) ' Chart updaten .Update() ' Pause einlegen bis zur nächsten Wertberechnung Delay(pSec) j += 1 If j = anzSeries Then j = 0 ' sind alle Endpunkte erreicht? Dim x As Boolean = Array.TrueForAll(dmax, AddressOf NoZeroValues) If x Then Exit Do ' alle Endpunkte erreicht Loop j = 0 Next Else ' Feld zum Registrieren, ob alle maximalen YValues von allen Serien erreicht Dim dbool(anzSeries - 1) As Boolean Dim k As Short Do For j = 0 To anzSeries - 1 ' für alle Serien xField = xdvFields(j) yField = ydvFields(j) iField = iniFields(j) For i = anfang To ende Step schritt iField(i) += theSteps(j) If theSteps(j) < 0 Then w = (iField(i) + theSteps(j) <= yField(i)) Else w = (iField(i) + theSteps(j) >= yField(i)) End If If w Then dmaxS(j)(i) += 1 ' dmax-Wert erhöhen, wenn maximaler YValue des Datapoint erreicht je Serie iField(i) = yField(i) Else dmaxS(j)(i) = 0 End If Next ' Series.Points nun mit Null-YValue-Feld verbinden ser = theSeries(j) ser.Points.DataBindXY(xField, iField) Next ' Chart updaten .Update() ' Pause einlegen bis zur nächsten Wertberechnung Delay(pSec) ' sind alle Endpunkte erreicht? For k = 0 To anzSeries - 1 Dim s() As Short = dmaxS(k) dbool(k) = Array.TrueForAll(s, AddressOf NoZeroValues) Next ' haben in allen Serien die YValues die Maximalwerte erreicht? Dim x As Boolean = Array.TrueForAll(dbool, Function(v As Boolean) Return (v = True) End Function) If x Then Exit Do ' alle Maximalwerte erreicht Loop End If ' eventuell Labels je Datapoint anzeigen If Not IsNothing(labeling) Then For k As Short = 0 To anzSeries - 1 If labeling(k) <> "" Then ser = theSeries(k) ser.Label = labeling(k) .Update() End If Next End If End With End Sub Aufrufbeispiel: AnimateSomeSeries(Chart1, {Chart1.Series("Umsatz"), Chart1.Series("Stunden")}, _ dv1.Count, {stp1, stp2}, {xdv1, xdv1}, {ydv1, ydv2}, _ {in1, in2}, delSec , CShort(Rnd()), , True, _ {"#VAL{C0}", "#VAL"}) Das Beispiel zeigt die Animation zweier Datenserien und die Übergabe von Parametern in Feldform. Bzgl. Auslösen der Animation gelten die Aussagen ebenfalls wie im Vorgängertipp. Dieser Tipp wurde bereits 6.694 mal aufgerufen.
Anzeige
![]() ![]() ![]() 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. |
sevOutBar 4.0 ![]() Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. Tipp des Monats Access-Tools Vol.1 ![]() Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |