Possible to persist Marks Tip?
Posted: Tue Mar 23, 2004 6:25 pm
I wonder if it is possible to keep the Marks Tip tool displayed indefinitely? As far as I can see, you can only set the initial delay.
Steema Software - Customer Support Forums
https://974310.kinnakethk.tech/
Code: Select all
Dim CrossActive As Boolean
Dim MouseXCursorPos, MouseYCursorPos As Double
Private Sub Form_Load()
CrossActive = True
With TChart1.Series(0)
' remove previous existing points from the Series
.Clear
' Fill sample values
.FillSampleValues 20
End With
TChart1.Panel.MarginRight = 18
TChart1.Panel.MarginBottom = 12
TChart1.Legend.Visible = False
End Sub
Private Sub tChart1_OnAfterDraw()
Dim XCursorPos, YCursorPos, XDifUp, XDifDown, YDifUp, YDifDown, XDifin, YDifin, XDifout, YDifout As Double
Dim XIndex, YIndex, OutYIndex, OutXIndex, i As Integer
With TChart1
If .SeriesCount > 0 Then
For i = 0 To .SeriesCount - 1
If (.Series(i).VerticalAxis = aRightAxis) And (.Series(i).Count > 0) Then
.Canvas.Font.Color = .Series(i).PointColor(0)
.Canvas.TextOut .Axis.Right.Position + 10, _
.Series(i).CalcYPos(0) - (.Canvas.TextHeight("t") / 2), _
"x=" & Str$(.Series(i).YValues.First)
End If
Next i
End If
End With
If CrossActive = True Then
With TChart1
If (MouseXCursorPos < .Axis.Right.Position) And (MouseXCursorPos > .Axis.Left.Position) And _
(MouseYCursorPos < .Axis.Bottom.Position) And (MouseYCursorPos > .Axis.Top.Position) Then
With .Series(0)
For i = 0 To .Count - 1
'differences to nearest points
XDifUp = .CalcXPos(i) - MouseXCursorPos
If XDifUp < 0 Then XDifUp = XDifUp * -1
If i > 0 Then
XDifDown = MouseXCursorPos - .CalcXPos(i - 1)
If XDifDown < 0 Then XDifDown = XDifDown * -1
Else
XDifDown = XDifUp + 1
If XDifDown < 0 Then XDifDown = XDifDown * -1
End If
YDifUp = MouseYCursorPos - .CalcYPos(i)
If YDifUp < 1 Then YDifUp = YDifUp * -1
If i > 0 Then
YDifDown = .CalcYPos(i - 1) - MouseYCursorPos
If YDifDown < 0 Then YDifDown = YDifDown * -1
Else
YDifDown = YDifUp + 1
If YDifDown < 0 Then YDifDown = YDifDown * -1
End If
If (XDifUp + YDifUp) < (XDifDown + YDifDown) Then
If Closest > (XDifUp + YDifUp) Or (i = 0) Then
XOutIndex = i
Closest = XDifUp + YDifUp
End If
Else
If Closest > (XDifDown + YDifDown) Or (i = 0) Then
XOutIndex = i - 1
Closest = XDifDown + YDifDown
End If
End If
Next i
XCursorPos = .CalcXPos(XOutIndex)
YCursorPos = .CalcYPos(XOutIndex)
End With
With .Canvas
.ClipRectangle TChart1.Axis.Left.Position, _
TChart1.Axis.Top.Position, _
TChart1.Axis.Right.Position, _
TChart1.Axis.Bottom.Position
.Pen.Color = vbWhite
.MoveTo TChart1.Axis.Left.Position, YCursorPos
.LineTo TChart1.Axis.Right.Position, YCursorPos
.MoveTo XCursorPos, TChart1.Axis.Top.Position
.LineTo XCursorPos, TChart1.Axis.Bottom.Position
.UnClipRectangle
.TextOut 10, .Height - 30, "Mouse X: " & Str$(CInt(TChart1.Axis.Bottom.CalcPosPoint(MouseXCursorPos))) & " , Y: " & Str$(CInt(TChart1.Axis.Left.CalcPosPoint(MouseYCursorPos)))
.TextOut 200, .Height - 30, "Nearest Point X: " & Str$(TChart1.Series(0).XValues.Value(XOutIndex)) & " , Y: " & Str$(TChart1.Series(0).YValues.Value(XOutIndex))
End With
End If
End With
End If
End Sub
Private Sub TChart1_OnMouseMove(ByVal Shift As TeeChart.EShiftState, ByVal X As Long, ByVal Y As Long)
Dim XCursorPos, YCursorPos As Double
If TChart1.Series(0).Count > 0 Then
CrossActive = True
MouseXCursorPos = X
MouseYCursorPos = Y
TChart1.Repaint
End If
End Sub