Convertion of mouse pointer coordinates into data coordinates and graphical object coordinates

我们两清 提交于 2019-12-31 05:36:10

问题


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

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!