使用 mousemove 在用户窗体中显示图表坐标

Question

我正在尝试制作当我将鼠标悬停在图表上时可以显示图表坐标的用户窗体

这里有一些解释：

-我有一个名为 "userform1" 的用户表单，它有一个名为 "image1"

的图像

-EDIT：相同的用户窗体具有高度（467.25）、左（0）、顶部（0）、宽度（876）、startupposition = 1-CenterOwner

-同一张图片高(426),左(6),上(6),宽(702)

-同一个用户表单有 2 个名为 "label_x" 和 "label_y"

的标签

-图像将导入 x 值为（0 到 100）和 y 值为（100 到 200）的图表

-下面的代码是当我将鼠标悬停在

上时显示image1的坐标

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim coor As POINTAPI

GetCursorPos coor

UserForm1.Label_x.caption = " X : " & coor.X
UserForm1.Label_y.caption = " Y : " & coor.Y
End Sub

-这里是当前代码的演示 the x and y value that shown are wrong

我已尝试通过要求用户单击图表的右上角和左下角来正确校准坐标来进行手动校准

但我认为用户这样做不会舒服

有没有自动校准图表坐标的方法？我认为这与用户窗体位置、图像位置和屏幕分辨率有关，但我不知道如何

谢谢

Answer 1

我想我已经知道怎么做了还是半自动的方法，希望以后可以给大家参考

还是希望有其他方法

这里是如何完成的

-首先我们需要获取用户屏幕分辨率

Declare PtrSafe Function GetSystemMetrics& Lib "User32" (ByVal nIndex&)
Sub ScreenResSize()

   Dim res_x As Long, res_y As Long

   res_x = GetSystemMetrics(0) ' width
   res_y = GetSystemMetrics(1) ' height

End Sub

-第二，我们需要手动获取图表的 2 个点，我取图表的左下角和右上角，然后使用这个计算和下面的子

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Semi automatic to show chart coordinate by : Efsion Andre

Dim coor As POINTAPI,xp1 As Double, xp2 As Double, yp1 As Double, yp2 As Double, xd1 As Double, xd2 As Double, yd1 As Double, yd2 As Double, xd As Double, yd As Double

GetCursorPos coor

xp1 = 280 'NEED MANUAL CALIBRATE BY PROGAMMER - BOTTOM LEFT OF CHART
xp2 = 1054 'NEED MANUAL CALIBRATE BY PROGAMMER - TOP RIGHT OF CHART
yp1 = 682 'NEED MANUAL CALIBRATE BY PROGAMMER - BOTTOM LEFT OF CHART
yp2 = 184 'NEED MANUAL CALIBRATE BY PROGAMMER - TOP RIGHT OF CHART

xp1 = (res_x - 1600) / 2 + xp1 'RECALCULATE BASED ON SCREEN RESOLUTION, MY SCREEN RESOLUTION IS 1600 X 900
xp2 = (res_x - 1600) / 2 + xp2 'RECALCULATE BASED ON SCREEN RESOLUTION, MY SCREEN RESOLUTION IS 1600 X 900
yp1 = (res_y - 900) / 2 + yp1 'RECALCULATE BASED ON SCREEN RESOLUTION, MY SCREEN RESOLUTION IS 1600 X 900
yp2 = (res_y - 900) / 2 + yp2 'RECALCULATE BASED ON SCREEN RESOLUTION, MY SCREEN RESOLUTION IS 1600 X 900

xd = (xd1 - xd2) / (xp1 - xp2) * (coor.X - xp2) + xd2 'CALIBRATION
yd = (yd1 - yd2) / (yp1 - yp2) * (coor.Y - yp2) + yd2 'CALIBRATION

userform1.Label_x.caption = " X : " & WorksheetFunction.RoundUp(xd, 2)
userform1.Label_y.caption = " Y : " & WorksheetFunction.RoundUp(yd, 2)

End Sub

使用 mousemove 在用户窗体中显示图表坐标

Showing chart coordinates in userform using mousemove

excel

vba

charts

userform

mouse-coordinates