powerpoint - 微软 PowerPoint : how to convert a shape's position and size into screen coordinates?

Question

我为 PowerPoint (2010) 写了一个小的 VBA 宏，当鼠标悬停在某个形状上时，它会打开一个带有解释的弹出窗口。这很好用。 las，再次离开该区域时没有触发任何事件，所以我现在想扩展代码，以便它监视弹出区域，当指针离开该区域时，它再次删除弹出窗口。

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

我在谷歌上搜索了很多次，但虽然我发现了几个最初很有希望的代码片段，但没有一个有效(因为大多数是针对 Excel 的，而 PowerPoint 显然有不同的文档模型)。

有好心人能给我一些提示或引用，告诉我如何将形状的尺寸转换为屏幕像素(即考虑缩放比例、窗口位置、缩放系数等)。

M.

Answer 1

以防万一有人感兴趣 - 这是经过大量进一步谷歌搜索后我的解决方案:

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
...