Display values on mouse move

[Petar]

Hi,

is it possible to display values for all series on mouse move as shown in the example below?

We would like to have on mouse move :

1. On left axe: highlighted values for each curve
2. On bottom axe highlighted value for the date
3. Dots on series to show where the mouse is

mouseMove_Values.png (92.66 KiB) Viewed 10007 times

Thanks,

Petar

[Narcís]

Hi Petar,

Yes, this is possible using interpolation as in this example:

Code: Select all

Option Explicit

Dim XCursorValue As Double

Private Sub Form_Load()
    TChart1.Aspect.View3D = False
    
    TChart1.AddSeries scLine
    TChart1.AddSeries scLine
    TChart1.AddSeries scLine
    
    TChart1.Tools.Add tcCursor
    TChart1.Tools.Items(0).asTeeCursor.FollowMouse = True
    TChart1.Tools.Items(0).asTeeCursor.Style = cssVertical
    
    Dim i As Integer
    
    For i = 0 To TChart1.SeriesCount - 1
        TChart1.Series(i).FillSampleValues (i + 1) * 20
    Next
   
End Sub

Function InterpolateSeries(ByVal SeriesIndex As Long, XValue As Double) As Double
    InterpolateSeries = InterpolateLineSeries(SeriesIndex, TChart1.Series(SeriesIndex).FirstValueIndex, TChart1.Series(SeriesIndex).LastValueIndex, XValue)
End Function

Function InterpolateLineSeries(ByVal SeriesIndex As Long, FirstIndex As Integer, LastIndex As Integer, XValue As Double) As Double
  Dim index As Integer
  Dim dx, dy, val As Double

  index = FirstIndex

  Do While ((TChart1.Series(SeriesIndex).XValues.Value(index) <= XValue) And (index < LastIndex))
    index = index + 1
  Loop
 
  ' safeguard
  If (index < 1) Then
    index = 1
  ElseIf (index >= TChart1.Series(SeriesIndex).Count) Then
    index = TChart1.Series(SeriesIndex).Count - 1
  End If
 
  ' y=(y2-y1)/(x2-x1)*(x-x1)+y1
  dx = TChart1.Series(SeriesIndex).XValues.Value(index) - TChart1.Series(SeriesIndex).XValues.Value(index - 1)
  dy = TChart1.Series(SeriesIndex).YValues.Value(index) - TChart1.Series(SeriesIndex).YValues.Value(index - 1)
 
  If (dx <> 0) Then
    InterpolateLineSeries = dy * (XValue - TChart1.Series(SeriesIndex).XValues.Value(index - 1)) / dx + TChart1.Series(SeriesIndex).YValues.Value(index - 1)
  Else
    InterpolateLineSeries = 0
  End If
End Function

Private Sub TChart1_OnCursorToolChange(ByVal Tool As Long, ByVal X As Long, ByVal y As Long, ByVal XVal As Double, ByVal YVal As Double, ByVal Series As Long, ByVal ValueIndex As Long)
    XCursorValue = XVal
    
    TChart1.Header.Text.Clear
    
    Dim i As Integer
    
    For i = 0 To TChart1.SeriesCount - 1
        TChart1.Header.Text.Add ("Series" + CStr(i) + ": Y(" + CStr(XVal) + ")= " + _
                 CStr(InterpolateLineSeries(i, TChart1.Series(i).FirstValueIndex, TChart1.Series(i).LastValueIndex, XVal)))
    Next
End Sub

Private Sub TChart1_OnAfterDraw()
    Dim xs, ys, i As Integer
    
    xs = TChart1.Axis.Bottom.CalcXPosValue(XCursorValue)
    
    For i = 0 To TChart1.SeriesCount - 1
        ys = TChart1.Axis.Left.CalcYPosValue(InterpolateSeries(i, XCursorValue))
        TChart1.Canvas.Brush.Color = TChart1.Series(i).Color
        TChart1.Canvas.Ellipse xs - 4, ys - 4, xs + 4, ys + 4
    Next
End Sub

[Petar]

Thanks Narcis,

this is perfect for the dots part. Is it possible now to highlight values directly on the left and the bottom axis.

Thanks,

Petar

[guilz2010]

Hi Narcis,

This method works fine but there is some performances issue with a large number of points (>3000 points)

interpolate.png (42.39 KiB) Viewed 10099 times

Is it possible to improve it especially when we move mouse cursor on the right part of the bottom axis ?

Thanks for your help

Guilz

[Narcís]

Hi Guilz,

Yes, highlighting could be done using Annotation tools, for example:

Code: Select all

Option Explicit

Dim XCursorValue As Double

Private Sub Form_Load()
    TChart1.Aspect.View3D = False
   
    TChart1.AddSeries scLine
    TChart1.AddSeries scLine
    TChart1.AddSeries scLine
   
    TChart1.Tools.Add tcCursor
    TChart1.Tools.Items(0).asTeeCursor.FollowMouse = True
    TChart1.Tools.Items(0).asTeeCursor.Style = cssVertical
   
    Dim i As Integer
   
    For i = 0 To TChart1.SeriesCount - 1
        TChart1.Series(i).FillSampleValues (i + 1) * 20
        TChart1.Tools.Add tcAnnotate 'one annotation for each series
    Next
   
    TChart1.Tools.Add tcAnnotate 'one annotation for X values.
End Sub

Function InterpolateSeries(ByVal SeriesIndex As Long, XValue As Double) As Double
    InterpolateSeries = InterpolateLineSeries(SeriesIndex, TChart1.Series(SeriesIndex).FirstValueIndex, TChart1.Series(SeriesIndex).LastValueIndex, XValue)
End Function

Function InterpolateLineSeries(ByVal SeriesIndex As Long, FirstIndex As Integer, LastIndex As Integer, XValue As Double) As Double
    Dim index As Integer
    Dim dx, dy, val As Double
    
    index = FirstIndex
    
    Do While ((TChart1.Series(SeriesIndex).XValues.Value(index) <= XValue) And (index < LastIndex))
      index = index + 1
    Loop
    
    ' safeguard
    If (index < 1) Then
      index = 1
    ElseIf (index >= TChart1.Series(SeriesIndex).Count) Then
      index = TChart1.Series(SeriesIndex).Count - 1
    End If
    
    ' y=(y2-y1)/(x2-x1)*(x-x1)+y1
    dx = TChart1.Series(SeriesIndex).XValues.Value(index) - TChart1.Series(SeriesIndex).XValues.Value(index - 1)
    dy = TChart1.Series(SeriesIndex).YValues.Value(index) - TChart1.Series(SeriesIndex).YValues.Value(index - 1)
    
    If (dx <> 0) Then
      InterpolateLineSeries = dy * (XValue - TChart1.Series(SeriesIndex).XValues.Value(index - 1)) / dx + TChart1.Series(SeriesIndex).YValues.Value(index - 1)
    Else
      InterpolateLineSeries = 0
    End If
End Function

Private Sub TChart1_OnCursorToolChange(ByVal Tool As Long, ByVal X As Long, ByVal y As Long, ByVal XVal As Double, ByVal YVal As Double, ByVal Series As Long, ByVal ValueIndex As Long)
    XCursorValue = XVal
   
    TChart1.Header.Text.Clear
   
    Dim i As Integer
   
    For i = 0 To TChart1.SeriesCount - 1
        TChart1.Header.Text.Add ("Series" + CStr(i) + ": Y(" + CStr(XVal) + ")= " + _
                 CStr(InterpolateLineSeries(i, TChart1.Series(i).FirstValueIndex, TChart1.Series(i).LastValueIndex, XVal)))
    Next
End Sub

Private Sub TChart1_OnAfterDraw()
    Dim xs, ys, y, i As Integer
   
    xs = TChart1.Axis.Bottom.CalcXPosValue(XCursorValue)
   
    For i = 0 To TChart1.SeriesCount - 1
        y = InterpolateSeries(i, XCursorValue)
        ys = TChart1.Axis.Left.CalcYPosValue(y)
        TChart1.Canvas.Brush.Color = TChart1.Series(i).Color
        TChart1.Canvas.Ellipse xs - 4, ys - 4, xs + 4, ys + 4
        
        With TChart1.Tools.Items(i + 1).asAnnotation
            .Text = Format(y, "0.00")
            .Shape.Color = vbRed
            .Shape.CustomPosition = True
            .Shape.Left = TChart1.Axis.Left.Position - 40
            .Shape.Top = ys - 10
        End With
    Next
    
    With TChart1.Tools.Items(4).asAnnotation
        .Text = Format(XCursorValue, "0.00")
        .Shape.Color = vbRed
        .Shape.CustomPosition = True
        .Shape.Left = xs - 10
        .Shape.Top = TChart1.Axis.Bottom.Position + 10
    End With
End Sub

Regarding the performance issue, the problem is that interpolation is calculated from first visible point in the series and loops through all the points in the series. Hence it takes longer the further the point is from the origin. Some optimization could be done in the InterpolateLineSeries so that loop doesn't go through all point in the series.

[Petar]

Thank you Narcis,

that's exactly what we were looking for. Extremely useful.

Thanks,

Petar

[guilz2010]

>Some optimization could be done in the InterpolateLineSeries so that loop doesn't go through all point in the series.

Yes. I tried to use the code bellow to optimize the InterpolateLineSeries method (loop is now starting near the mouse position and not from the FirstValueIndex)

Code: Select all

Private Sub TChart1_OnMouseMove(ByVal Shift As TeeChart.EShiftState, ByVal X As Long, ByVal Y As Long)
    firstIndex = TChart1.Axis.Bottom.CalcPosPoint(X)
End Sub

It's seem to work fine

Thanks a lot for your help

Guilz