VBA实战技巧23：动态显示绘图区坐标值

Option Private Module
 
' 在X中的像素/英寸
Private Const LOGPIXELSX = 88
 
'1磅定义为1/72英寸
Private Const POINTS_PER_INCH As Long = 72
 
''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数声明
''''''''''''''''''''''''''''''''''''''''''''''''''
'获取窗口的设备上下文（绘图层）的句柄
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
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 用途: 计算像素大小, 以磅为单位.
'       取决于用户的DPI设置
'       控制面板> 显示 > 设置> 高级 > 通用
'       '正常'设置是96dpi, 其中1像素 =0.75 磅
'       '大'设置是120dpi, 其中1像素 =0.8 磅
'
' 参数: 无
'
' 返回:Double  像素的大小,以磅为单位.
'
Public Function PointsPerPixel() As Double
 
    Dim hDC As Long
    Dim lDotsPerInch As Long
 
   '获取桌面窗口设备上下文(例如, 屏幕)
    hDC =GetDC(0)
 
   '获取用户的DPI设置
   lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
 
   '用每英寸72磅除以dpi得出像素的宽度
   PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
 
   '释放设备上下文, 以进行整理
    ReleaseDC 0, hDC
End Function

' 说明: 演示在不同的图表坐标系之间转换的类
'
' 模块级变量,勾挂图表的事件
Public WithEvents mchtChart As Chart
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 用途: 当用户围绕图表移动鼠标时,
'       转换鼠标坐标为数据并绘制对象坐标,
'       更新状态栏且移动圆.
Private Sub mchtChart_MouseMove(ByVal Button AsLong, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
 
    Dim dZoom As Double
    Dim dXVal As Double
    Dim dYVal As Double
    Dim dPixelSize As Double
 
    On Error Resume Next
 
   '活动窗口缩放系数
    dZoom =ActiveWindow.Zoom / 100
 
   '像素尺寸, 以磅为单位
   dPixelSize = PointsPerPixel
 
   '鼠标坐标到数据坐标
    With mchtChart
        dXVal= .Axes(xlCategory).MinimumScale + (.Axes(xlCategory).MaximumScale -.Axes(xlCategory).MinimumScale) * (X * dPixelSize / dZoom -(.PlotArea.InsideLeft + .ChartArea.Left)) / .PlotArea.InsideWidth
        dYVal= .Axes(xlValue).MinimumScale + (.Axes(xlValue).MaximumScale -.Axes(xlValue).MinimumScale) * (1 - (Y * dPixelSize / dZoom -(.PlotArea.InsideTop + .ChartArea.Top)) / .PlotArea.InsideHeight)
    End With
 
   Application.StatusBar = "(" & Application.Round(dXVal, 2)& ", " & Application.Round(dYVal, 2) & ")"
 
   '鼠标坐标到绘制图对象点.
   '如果按下Shift键则移动绘制的对象
    If Shift= 1 Then
        With mchtChart
           dXVal = (X * dPixelSize / dZoom - .ChartArea.Left)
           dYVal = (Y * dPixelSize / dZoom - .ChartArea.Top)
 
           With .Shapes("ovlPointer")
               .Left = dXVal - .Width / 2
               .Top = dYVal - .Height / 2
           End With
        End With
    End If
End Sub

Dim mclsChart As CChart
 
'初始化图表事件句柄
Private Sub Workbook_Open()
    Set mclsChart = New CChart
    Set mclsChart.mchtChart = wksCoordinates.ChartObjects(1).Chart
End Sub