2

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

以下是一些解释：

-我有名为“userform1”的用户表单，其中有名为“image1”的图像

-编辑：相同的用户表单具有高度（467.25），左（0），顶部（0），宽度（876），启动位置= 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

- 这是当前代码的演示，显示 的 x 和 y 值是错误的

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

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

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

谢谢

4

1 回答 1

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 个点，我取图表的左下角和右上角，然后使用这个计算和下面的 sub

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
于 2018-02-11T08:01:35.230 回答