Page 1 of 1

How do I get the absolute X coordinate of an asTeeCursor?

Posted: Wed Aug 30, 2006 9:59 pm
by 9527388
I am displaying mulitple asTeeCursors in my trend; along with the Cursors, I am displaying some associated text (using canvas textout) positioned next to the Cursor. When I move the cursor, the text moves along with the cursor, which is exactly what I want it to do. However, the issue that I am having is when I resize the display, such that the size of the trend area increases (or decreases) along with the display. When this happens, the asTeeCursors also move to the correct relative position in the trend, but the text remains where it was originally position before the resize. The positioning of the canvas.textout uses the true X coordinate, whereas the positioning of the asTeeCursor object is by XVal which corresponds to the Series XScreenToValue(X) value.

When I reposition the asTeeCursor by selecting and moving the vertical cursor (with the mouse) the code in TChart1_OnCursorToolChange is invoked which updates the position of the asTeeCursor and redraws the canvas.textout text. However, when doing a resize, the TChart1_OnCursorToolChange is not invoked, hence the position of the canvas.textout does not change and remains the same.

Any help you can provide on being able to reposition the canvas.textout with it's associated asTeeCursor would be appreciated.

Thanks
Scott

See code below:

Code: Select all

Dim ExistsCustomAxis As Boolean
Dim cursorArrayXPos() As Integer
Dim cursorArrayValue() As Variant
Const numCursors = 10


Private Sub Check1_Click()
  If Check1.Value = 1 Then
    TChart1.Series(0).VerticalAxis = aBothVertAxis
  Else
    TChart1.Series(0).VerticalAxis = aLeftAxis
  End If
  TChart1.Series(1).VerticalAxis = TChart1.Series(0).VerticalAxis
End Sub

Private Sub Check2_Click()
  'Multiline Axis Labels
  If Check2.Value = 1 Then
    TChart1.Axis.Bottom.Labels.MultiLine = True
    'Adjust Bottom margin
    TChart1.Panel.MarginBottom = TChart1.Panel.MarginBottom + 3
  Else
    TChart1.Axis.Bottom.Labels.MultiLine = False
    TChart1.Panel.MarginBottom = TChart1.Panel.MarginBottom - 3
  End If
End Sub

Private Sub chkHLC_Click()
    Call ProcessHLC
End Sub

Private Sub Command1_Click()
  Dim tmpAxisPos As Integer
  
  tmpAxisPos = TChart1.Axis.Left.Position + (TChart1.Axis.Right.Position - TChart1.Axis.Left.Position) / 2
  TChart1.Axis.Left.CustomDraw tmpAxisPos - 10, tmpAxisPos, tmpAxisPos, True
  ExistsCustomAxis = True
End Sub

Private Sub Command2_Click()
Dim tmpAxisPos As Integer
  'Reset Bottom Axis
  TChart1.Axis.Bottom.PositionPercent = 0
  'Setup Series(0) with Left Axis
  TChart1.Series(0).VerticalAxis = aLeftAxis
  TChart1.Axis.Left.PositionPercent = 0
  TChart1.Axis.Left.StartPosition = 0
  TChart1.Axis.Left.EndPosition = 45
  'Setup Series(1) with Right Axis
  TChart1.Series(1).VerticalAxis = aRightAxis
  TChart1.Axis.Right.PositionPercent = 0
  TChart1.Axis.Right.StartPosition = 55
  TChart1.Axis.Right.EndPosition = 100
  
  'Disable non-compatible demo feature
  Check1.Enabled = False
End Sub

Private Sub Form_Load()
    Dim i
    ReDim cursorArrayXPos(numCursors) As Integer
    ReDim cursorArrayValue(numCursors, 20) As Variant
    With TChart1
      For i = 0 To 20
       .Series(0).Add Rnd(30), "", clTeeColor
       .Series(1).Add Rnd(30), "", clTeeColor
       .Series(2).Add Rnd(30), "", clTeeColor
       .Series(3).Add Rnd(30), "", clTeeColor
      Next i
    End With
      ' Add  cursors
    TChart1.Tools.Add tcCursor
    With TChart1.Tools.Items(0).asTeeCursor
        .FollowMouse = True
        .Style = cssVertical
        .Pen.Color = vbBlue
        .Pen.Style = psSolid
        .Pen.Width = 3
    End With
    For i = 1 To numCursors - 1
      TChart1.Tools.Add tcCursor
      With TChart1.Tools.Items(TChart1.Tools.Count - 1).asTeeCursor
          .FollowMouse = False
          .Style = cssVertical
          .Pen.Color = vbGreen
          .Pen.Style = psClear
          .Pen.Width = 3
          .Series = 0
      End With
    Next i
  
    ExistsCustomAxis = False
End Sub

Private Sub Form_Resize()
    TChart1.Width = Form1.Width
    Call TChart1_OnAfterDraw
    
End Sub

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)
    If tool > 0 Then
        cursorArrayXPos(tool) = X
    End If
    Call CalcCursorValues(tool, X)
    Call TChart1.Repaint
    
End Sub

Sub CalcCursorValues(tool As Long, X As Long)
    
    g_sCursorXValue = TChart1.Series(1).XValueToText(XVal)
    
    Dim MyStart, MyEnd, XResult, YResult, Result, OldResult, ResultIndex
     cursorArrayValue(tool, TChart1.SeriesCount - 1) = "Null"
    
    For i = 0 To TChart1.SeriesCount - 1

        With TChart1
            MyStart = .Series(i).FirstValueIndex
            MyEnd = .Series(i).LastValueIndex
            '/// added to seed value incase no values exist in Series.
            If MyStart = -1 Or MyEnd = -1 Then Exit For
            OldResult = .Series(i).CalcXPosValue(.Series(i).XValues.Maximum) ^ 2 + .Series(i).CalcYPosValue(.Series(i).YValues.Maximum) ^ 2
            For j = MyStart To MyEnd
                XResult = .Series(i).CalcXPos(j)
                '/// find series value to the left of the cursor position
                If X < XResult Then
                    ResultIndex = j - 1
                    If ResultIndex >= 0 Then
                        cursorArrayValue(tool, i) = Format(.Series(i).YValues.Value(ResultIndex), "#.00")
                        'if g_afCursorValue(i-1) = -.987654321987654321 then
                        If .Series(i).IsNull(ResultIndex) Then
                            cursorArrayValue(tool, i) = "Null"
                        End If
                        Exit For
                    Else
                        If cursorArrayValue(tool, i) = -0.987654321987654 Then
                            cursorArrayValue(tool, i) = "Null"
                        End If
                    End If
                ElseIf j = MyEnd Then
                    ResultIndex = j
                    cursorArrayValue(tool, i) = .Series(i).YValues.Value(ResultIndex)
                    If .Series(i).IsNull(ResultIndex) Then
                        cursorArrayValue(tool, i) = "Null"
                    End If
                    Exit For
                
                
                End If
            Next
        End With
    Next

    TChart1.Repaint

End Sub

Private Sub TChart1_OnMouseDown(ByVal Button As TeeChart.EMouseButton, ByVal Shift As TeeChart.EShiftState, ByVal X As Long, ByVal Y As Long)
     '/// add cursor
    If Shift = ssShift Then
        With TChart1.Tools.Items(0).asTeeCursor
            .Series = 0
            .FollowMouse = True
            .Style = cssVertical
            .Pen.Color = vbRed
            .Pen.Style = psSolid
            .Pen.Width = 2
           '// .XVal = X
        End With
      
        For i = 1 To numCursors - 2
            With TChart1.Tools.Items(i).asTeeCursor
                If .Pen.Style = psClear Then
                    .Series = 0
                    .FollowMouse = False
                    .Style = cssVertical
                    .Pen.Color = vbGreen
                    .Pen.Style = psDash
                    .Pen.Width = 2
                    .XVal = TChart1.Series(0).XScreenToValue(X)
                    'MsgBox .XVal
                    cursorArrayXPos(i) = X
                    Exit For
                End If
            End With
        Next i
        'clear last added cursor
    ElseIf Shift = ssAlt Then
         For i = numCursors To 1 Step -1
            With TChart1.Tools.Items(i).asTeeCursor
                If .Pen.Style <> psClear Then
                    .Pen.Style = psClear
                    .Pen.Width = 2
                    .XVal = TChart1.Series(0).XScreenToValue(X)
                    cursorArrayXPos(i) = X
                    Exit For
                End If
            End With
        Next i
    
        '/// clear all cursors
    ElseIf Shift = ssCtrl Then
         For i = numCursors - 1 To 1 Step -1
            With TChart1.Tools.Items(i).asTeeCursor
                If .Pen.Style <> psClear Then
                    .Pen.Style = psClear
                    .Pen.Width = 2
                    .XVal = TChart1.Series(0).XScreenToValue(X)
                    cursorArrayXPos(i) = X
                    
                End If
            End With
        Next i
       
    
    End If
    
  

End Sub


Private Sub HScroll1_Change()
  TChart1.Axis.Left.PositionPercent = HScroll1.Value
End Sub

Private Sub TChart1_OnAfterDraw()
    Dim i As Integer
    Dim j As Integer
    
    Dim myMessage As String
    Dim nLineHeight As Integer
    
    
  If ExistsCustomAxis = True Then
    Command1_Click
  End If
  
    nLineHeight = 10 * TChart1.Axis.Left.Labels.Font.PixelsPerInch / 72 + 1
  For i = 1 To TChart1.Tools.Count - 1
    With TChart1.Tools.Items(i).asTeeCursor
        If .Pen.Style <> psClear Then

            For j = 0 To TChart1.SeriesCount - 1
                  ' This prepares the Font attributes
                TChart1.Canvas.Font.Name = TChart1.Header.Font.Name
                ' This sets the Text background mode to Transparent
                TChart1.Canvas.Brush.Style = bsCross
                TChart1.Canvas.BackMode = cbmTransparent
                'TChart1.Canvas.Brush.Color = TChart1.Series(j).Color
                TChart1.Canvas.Brush.Color = vbWhite
                TChart1.Canvas.Pen.Color = vbRed
                TChart1.Canvas.Pen.Style = psDot
                TChart1.Canvas.Font.Color = TChart1.Series(j).Color
                myMessage = cursorArrayValue(i, j)
                TChart1.Canvas.TextOut (cursorArrayXPos(i)), (TChart1.Canvas.Top + nLineHeight * j), myMessage
            Next

        End If
    End With
  Next i

End Sub






Private Sub TChart1_OnDblClick()
  TChart1.ShowEditor
End Sub




Private Sub VScroll1_Change()
  TChart1.Axis.Bottom.PositionPercent = 100 - VScroll1.Value
End Sub

Private Sub ProcessHLC()

    ' Handles Hairline cursor checkbox "onclick" event.
    ' Shows or hides hairline cursor.
    
    With TChart1.Tools.Items(0).asTeeCursor
        If chkHLC.Value = Checked Then
            .Pen.Style = g_psDot
            .FollowMouse = True
            g_bCursorMode = True
        Else
            .Pen.Style = g_psClear
            .FollowMouse = False
            g_bCursorMode = False
        End If
    End With
End Sub


Posted: Thu Aug 31, 2006 8:15 am
by narcis
Hi Scott,

One possible solution could be updating the custom text drawing using TeeChart's OnResize event.