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
