MS PowerPoint：如何将形状的位置和大小转换为屏幕坐标？

我写了我一个小VBA宏PowerPoint的（2010），其上空盘旋一些形状，当打开与解释一个弹出。这工作正常。唉，当再次离开区域时不会触发事件，所以我现在想要扩展代码以便监视弹出窗口的区域，并且当指针离开该区域时，它将再次移除弹出窗口。MS PowerPoint：如何将形状的位置和大小转换为屏幕坐标？

但是现在我遇到了一些愚蠢的问题：Shape（.Left，.Top，.Width和.Height）的坐标在一些“文档单位”中给出（不清楚这是什么单位在）。然而，指针坐标显然在屏幕像素中。为了能够合理地比较两者来计算指针是内部还是外部，我需要首先将Shape的尺寸转换为屏幕像素。

我用Google搜索周围很多，但是当我发现在第一次有前途的代码片段数，没有这些工作（因为大多数人对于Excel和PowerPoint显然有不同的文档模型）。

能否某种灵魂给我一个提示或者一些参考如何在外形的尺寸转换成屏幕像素（即回吐缩放，窗口位置，缩放因素等考虑在内）。

来源

2013-01-31 mmo

任何指针从哪里开始的，检测鼠标事件？ – Cilvic

形态（。左，.TOP，.WIDTH和.Height）的坐标在一些 “文档单位” 给出了（不知道究竟该单位在）。

积分。英寸72点。

Sub TryThis() 
    Dim osh As Shape 
    Set osh = ActiveWindow.Selection.ShapeRange(1) 
    With ActiveWindow 
     Debug.Print .PointsToScreenPixelsX(.Left) 
     Debug.Print .PointsToScreenPixelsY(.Top) 
    End With 
End Sub

来源

2013-02-01 03:31:05

唉，这不起作用。我总是收到“非法值”的错误。看来，在幻灯片模式下没有ActiveWindow。所以我尝试使用ActivePresentation.SlideShowWindow来代替，但该对象没有任何.PointsToScreenPixelsX/Y方法。有任何想法吗？ – mmo

你仍然可以到达那里。幻灯片视图将使用幻灯片填充屏幕。 WIN API调用可以给你屏幕分辨率，或者如果你控制PC，你可以对它进行硬编码，所以这是一个比率问题;你知道在幻灯片上形状的位置/大小，你知道幻灯片的10" 宽成为屏幕上的1024个或howevermany像素，所以它只是比从那里，变得有点棘手，如果你的幻灯片比例不与屏幕比例相匹配，但这只是增加了一个步骤或进行计算。 –

不！不！我们不会做这种脆弱的布置，只适用于一台机器，但不适用于另一台机器。 – mmo

如果任何人的兴趣 - 在这里进一步的谷歌搜索的地段后，我的解决方案：

Type POINTAPI 
    x As Long 
    y As Long 
End Type 

Type Rectangle 
    topLeft As POINTAPI 
    bottomRight As POINTAPI 
End Type 

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long 
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long 

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 

Private Function TransformShape(osh As Shape) As Rectangle 
    Dim zoomFactor As Double 
    zoomFactor = ActivePresentation.SlideShowWindow.View.zoom/100 

    Dim hndDC& 
    hndDC = GetDC(0) 
    Dim deviceCapsX As Double 
    deviceCapsX = GetDeviceCaps(hndDC, 88)/72 ' pixels per pt horizontal (1 pt = 1/72') 
    Dim deviceCapsY As Double 
    deviceCapsY = GetDeviceCaps(hndDC, 90)/72 ' pixels per pt vertical (1 pt = 1/72') 

    With TransformShape 
     ' calculate: 
     .topLeft.x = osh.Left * deviceCapsX * zoomFactor 
     .topLeft.y = osh.Top * deviceCapsY * zoomFactor 
     .bottomRight.x = (osh.Left + osh.width) * deviceCapsX * zoomFactor 
     .bottomRight.y = (osh.Top + osh.height) * deviceCapsY * zoomFactor 
     ' translate: 
     Dim lngStatus As Long 
     lngStatus = ClientToScreen(hndDC, .topLeft) 
     lngStatus = ClientToScreen(hndDC, .bottomRight) 
    End With 

    ReleaseDC 0, hndDC 
End Function 

... 
Dim shapeAsRect As Rectangle 
shapeAsRect = TransformShape(someSape) 

Dim pointerPos As POINTAPI 
Dim lngStatus As Long 
lngStatus = GetCursorPos(pointerPos) 

If ((pointerPos.x <= shapeAsRect.topLeft.x) Or (pointerPos.x >= shapeAsRect.bottomRight.x) Or _ 
    (pointerPos.y <= shapeAsRect.topLeft.y) Or (pointerPos.y >= shapeAsRect.bottomRight.y)) Then 
    ' outside: 
    ... 
Else ' inside 
    ... 
End If 
...

来源

2013-02-02 13:36:12 mmo

MS PowerPoint：如何将形状的位置和大小转换为屏幕坐标？

回答

相关问题