Page 1 of 1
10 points fade
Posted: Fri Jun 10, 2005 8:33 am
by 6922264
Hi,
I have a chart in which I want only 10 values and the point color should fade out from red. Currently it looks like this:
Code: Select all
chtOptimalTrim.Series(0).AddXY rValue, rYValue, "", vbRed
If chtOptimalTrim.Series(0).Count < 10 Then
icnt = chtOptimalTrim.Series(0).Count
For i = 1 To icnt
chtOptimalTrim.Series(0).PointColor(i) = RGB((i + 10 - icnt) * 25, 0, 0)
Next
Else
For i = 1 To 10
chtOptimalTrim.Series(0).PointColor(i) = RGB(i * 25, 0, 0)
Next
End If
Do While chtOptimalTrim.Series(0).Count > 10
chtOptimalTrim.Series(0).Delete 0
Loop
My problem is that the points aren't added at the end, a new value can be added at any index (I've checked it by printing the result of AddXY-function)
Ideas anyone?
Is there a difference in the chart type? (XY or line, I'm using a line)
TIA
/Kejpa
Posted: Fri Jun 10, 2005 9:11 am
by narcis
Hi Kejpa,
Using color below works fine using latest version available (v7.0.0.4). This snippet adds a random number of points, up to 20 and adds random values so that they are not ordered. Everytime a new point is added points colors are calculated according to their current order.
Code: Select all
Private Sub Form_Load()
Dim NumPoints As Integer
Randomize
NumPoints = Rnd(100) * 20
For j = 0 To NumPoints
rValue = Rnd(100) * 100
rYValue = Rnd(100) * 100
chtOptimalTrim.Series(0).AddXY rValue, rYValue, "", vbRed
If chtOptimalTrim.Series(0).Count < 10 Then
icnt = chtOptimalTrim.Series(0).Count
For i = 1 To icnt
chtOptimalTrim.Series(0).PointColor(i) = RGB((i + 10 - icnt) * 25, 0, 0)
Next
Else
For i = 1 To 10
chtOptimalTrim.Series(0).PointColor(i) = RGB(i * 25, 0, 0)
Next
End If
Do While chtOptimalTrim.Series(0).Count > 10
chtOptimalTrim.Series(0).Delete 0
Loop
Next
End Sub
Could you please test if i works for you? And if not which is the problem?
Posted: Fri Jun 10, 2005 10:19 am
by 6922264
No,
it doesn't work as I would like it to. It still deletes the value with the lowest x-value not the first added.
I modified a bit, to show you.
Code: Select all
Dim aXValues(20) As Double
Dim aYValues(20) As Double
Dim iIndex As Integer
Private Sub Form_Click()
chtOptimalTrim.Series(0).AddXY aXValues(iIndex), aYValues(iIndex), "", clTeeColor
If chtOptimalTrim.Series(0).Count <= 10 Then
icnt = chtOptimalTrim.Series(0).Count - 1
For i = 1 To icnt
chtOptimalTrim.Series(0).PointColor(i) = RGB(0, 0, (i + 10 - icnt) * 25)
Next
Else
For i = 1 To 10
chtOptimalTrim.Series(0).PointColor(i) = RGB(0, 0, i * 25)
Next
End If
Do While chtOptimalTrim.Series(0).Count > 10
chtOptimalTrim.Series(0).Delete 0
Loop
iIndex = (iIndex + 1) Mod (UBound(aXValues) + 1)
End Sub
Private Sub Form_DblClick()
Dim NumPoints As Integer
Randomize
NumPoints = 20
chtOptimalTrim.Series(0).Clear
iIndex = 0
For j = 0 To NumPoints
aXValues(j) = Rnd(100) * 100
aYValues(j) = Rnd(100) * 100
Debug.Print j; aXValues(j), aYValues(j)
Next
Form_Click
End Sub
Private Sub Form_Load()
Form_DblClick
End Sub
In the debug window you have the order of the points to be added, when you click on the form the values will be added one at a time, the last value to be added should be red, and the others fade from blue to black. When you have 10 points the black should be deleted next time you click the form but instead the point with the smallest x-value is deleted. When all the values have been added it starts from the beginning again.
Best regards!
/Kejpa
Work around, still not good though
Posted: Mon Jun 13, 2005 8:57 am
by 6922264
Hi,
I've made a work around, but it's still not good.
Code: Select all
Private Sub AddValue(rValue As Single)
Dim i, icnt As Integer
Static aValues(1, 9) As Single
icnt = cht.Series(0).Count
cht.Series(0).Clear
Do While i < icnt
aValues(0, i) = aValues(0, i + 1)
aValues(1, i) = aValues(1, i + 1)
cht.Series(0).AddXY aValues(0, i), aValues(1, i), "", RGB((i + 10 - icnt) * 25, 0, 0)
If i = 8 Then
Exit Do
Else
i = i + 1
End If
Loop
aValues(0, i + 1) = rValue
aValues(1, i + 1) = 72000
cht.Series(0).AddXY rValue, 72000, "", vbRed
End Sub
This way I can control the color of each point and fade them properly.
It looks good as long as the x-values increase and then stop, however if the x-values decrease and then stop all the points are hidden by the first value which is black, and not visible. There is no property to set that last added values should land on top of older
Do any of you have other ideas?
TIA
/Kejpa
Posted: Mon Jun 13, 2005 10:30 am
by narcis
Hi Kejpa,
Could you please try if the code below works as you want?
Code: Select all
Dim aXValues(20) As Double
Dim aYValues(20) As Double
Dim iIndex As Integer
Private Sub Form_Click()
chtOptimalTrim.Series(0).AddXY aXValues(iIndex), aYValues(iIndex), "", clTeeColor
If chtOptimalTrim.Series(0).Count <= 10 Then
icnt = chtOptimalTrim.Series(0).Count - 1
For i = 1 To icnt
chtOptimalTrim.Series(0).PointColor(i) = RGB(0, 0, (i + 10 - icnt) * 25)
Next
Else
For i = 1 To 10
chtOptimalTrim.Series(0).PointColor(i) = RGB(0, 0, i * 25)
Next
End If
chtOptimalTrim.Series(0).XValues.Sort
chtOptimalTrim.Series(0).YValues.Sort
Do While chtOptimalTrim.Series(0).Count > 10
chtOptimalTrim.Series(0).Delete 0
Loop
iIndex = (iIndex + 1) Mod (UBound(aXValues) + 1)
End Sub
Private Sub Form_DblClick()
Dim NumPoints As Integer
Randomize
NumPoints = 20
chtOptimalTrim.Series(0).Clear
iIndex = 0
For j = 0 To NumPoints
aXValues(j) = Rnd(100) * 100
aYValues(j) = Rnd(100) * 100
Debug.Print j; aXValues(j), aYValues(j)
Next
Form_Click
End Sub
Private Sub Form_Load()
chtOptimalTrim.Series(0).XValues.Order = loNone
chtOptimalTrim.Series(0).YValues.Order = loNone
Form_DblClick
End Sub
Posted: Mon Jun 13, 2005 11:52 am
by 6922264
Thanx NarcĂs!
Works swell.