10 points fade

[SAJ]

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

[Narcís]

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?

[SAJ]

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

[SAJ]

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

[Narcís]

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

[SAJ]

Thanx Narcís!
Works swell.