问题
I googled all the day and, with my surprise, I have found only old (many years ago) answers about the topic. I tryed to mix individual pieces of code of the above mentioned answers to get a more complete solution to my needs, but nothing seems to work in the right way. The proposed solutions, even if logically understandable, don't work as expected.
This should be the conceptual framework for coordinates implemented by Excel
1------------------------------------------+
|ChartObject |
| 2--------------------------------------+ |
| |ChartArea | |
| | | |
| | +--------------------------------+ | |
| | |PlotArea | | |
| | | 20 +-----------------------+| | |
| | | | 'Inside' dimensions || | |
| | | 10 | || | |
| | | | || | |
| | | 0 +-----------------------+| | |
| | +--------------------------------+ | |
| +--------------------------------------+ |
+------------------------------------------+
Point 1 is the origin for X and Y values passed to chart mouse events. Point 2 is the origin for the PlotArea.InsideLeft and PlotArea.InsideTop properties. The difference is the ChartArea.Left and ChartArea.Top property value, respectively.
The Varibles oX, oY (graphical object coordinates) and dX, dY (data coordinates) don't give the expected results calculated in such the way.
Below you can find the code I used (MouseUp event for troubleshooting purpose only... MouseMove event will be the choice)
Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#Else
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If
Private Const LOGPIXELSX = 88 'Pixels/inch in X
Private Const LOGPIXELSY = 90 'Pixels/inch in Y
Private Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches
Private WithEvents m_oChart As Chart
Public Property Set Chart(ByVal oChart As Chart)
Set m_oChart = oChart
End Property
Private Sub m_oChart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
'X, Y are the mouse pointer coordinates from the MouseMove event (measured in pixels).
'These coordinates are affected by the worksheet wZoom factor
Dim ElementID As Long
Dim a As Long, b As Long
Dim wZoom As Double
Dim psX As Double, psY As Double
Dim caLeft As Double
Dim caTop As Double
Dim oX As Double, oY As Double, oMin As Double, oMax As Double
Dim dX As Double, dY As Double, dMin As Double, dMax As Double
wZoom = ActiveWindow.zoom / 100
psX = PointsPerPixelX
psY = PointsPerPixelY
With m_oChart
caLeft = .ChartArea.Left: If caLeft > 2 ^ 31 Then caLeft = caLeft - 2 ^ 32
caTop = .ChartArea.Top: If caTop > 2 ^ 31 Then caTop = caTop - 2 ^ 32
oMin = .PlotArea.InsideLeft
oMax = .PlotArea.InsideLeft + .PlotArea.InsideWidth
oX = (X - IIf(wZoom > 1, 6 * (wZoom - 1), 0)) * psX / wZoom - caLeft
oY = (Y - IIf(wZoom > 1, 6 * (wZoom - 1), 0)) * psY / wZoom - caTop
dMin = .Axes(xlCategory).MinimumScale
dMax = .Axes(xlCategory).MaximumScale
dX = (X - IIf(wZoom > 1, 6 * (wZoom - 1), 0)) * psX / wZoom
dX = dMin + (dMax - dMin) * (dX - (.PlotArea.InsideLeft + caLeft)) / .PlotArea.InsideWidth
dMin = .Axes(xlValue).MinimumScale
dMax = .Axes(xlValue).MaximumScale
dY = (Y - IIf(wZoom > 1, 6 * (wZoom - 1), 0)) * psY / wZoom
dY = dMin + (dMax - dMin) * (1 - (dY - (.PlotArea.InsideTop + caTop)) / .PlotArea.InsideHeight)
End With
End Sub
Private Function PointsPerPixelX() As Double
'the size of a pixel, in points
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixelX = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
Private Function PointsPerPixelY() As Double
'the size of a pixel, in points
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
PointsPerPixelY = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
I used the coordinates oX, oY (graphical object coordinates) for tracking the mouse pointer position with two dynamic moving H/V line objects
Private Sub ViewTrackerLines(View As Boolean, ch As Chart, Optional pntX As Double, Optional pntY As Double)
Dim sh As Shape
On Error Resume Next
If View = True Then
Set sh = ch.Shapes("VTrackLine")
If sh Is Nothing Then
Set sh = ch.Shapes.AddLine(BeginX:=0, BeginY:=0, EndX:=0, EndY:=0)
With sh
.Name = "VTrackLine"
.Left = pntX
.Top = ch.PlotArea.InsideTop
.Height = ch.PlotArea.InsideHeight
.Width = 0
End With
With sh.Line
.Weight = 0.5
.ForeColor.RGB = RGB(91, 155, 213) ' light blue
.DashStyle = msoLineDash
.Transparency = 0
End With
sh.Visible = msoTrue
Else
sh.Left = pntX
End If
Set sh = Nothing
Set sh = ch.Shapes("HTrackLine")
If sh Is Nothing Then
Set sh = ch.Shapes.AddLine(BeginX:=0, BeginY:=0, EndX:=0, EndY:=0)
With sh
.Name = "HTrackLine"
.Left = ch.PlotArea.InsideLeft
.Top = pntY
.Height = 0
.Width = ch.PlotArea.InsideWidth
End With
With sh.Line
.Weight = 0.5
.ForeColor.RGB = RGB(91, 155, 213) ' light blue
.DashStyle = msoLineDash
.Transparency = 0
End With
sh.Visible = msoTrue
Else
sh.Top = pntY
End If
Set sh = Nothing
Else
Set sh = ch.Shapes("HTrackLine"): sh.Delete
Set sh = ch.Shapes("VTrackLine"): sh.Delete
End If
End Sub
and I used dX, dY (data coordinates) to display the current Axis values matching the mouse pointer position too.
Private Sub ViewDataCoord(View As Boolean, ch As Chart, Optional pntX As Double, Optional pntY As Double)
Dim Fn As Object
Set Fn = Application.WorksheetFunction
If View = True Then
Application.StatusBar = "(" & Fn.Round(pntX, 2) & " , " & Fn.Round(pntY, 2) & ")"
Else
Application.StatusBar = ""
End If
End Sub
The results are not as expected because, trivially, both the H/V lines and Axis values don't match with the displayed mouse pointer position.
Any suggestion will be really appreciated
来源:https://stackoverflow.com/questions/57915079/convertion-of-mouse-pointer-coordinates-into-data-coordinates-and-graphical-obje