MS PowerPoint:如何将形状的位置和大小转换为屏幕坐标? [英] MS PowerPoint: how to convert a shape's position and size into screen coordinates?

问题描述

我给我写了一个PowerPoint的VBA宏(2010)，当将鼠标悬停在某些Shape上时，会打开一个弹出窗口并带有说明.这很好. las，再次离开该区域时没有触发任何事件，因此我现在想扩展代码，使其监视弹出窗口的区域，当指针离开该区域时，它将再次删除该弹出窗口.

I wrote me a little VBA Macro for PowerPoint (2010) that opens a popup with explanations when hovering over some Shape. This works fine. Alas, there is no event that is triggered when leaving the area again and so I now want to extend the code such that it monitors the area of the popup and when the pointer leaves that area it removes the popup again.

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

But now I ran into some stupid problem: the coordinates of the Shape (.Left, .Top, .Width, and .Height) are given in some "document units" (don't know exactly what unit this is in). The pointer coordinates, however, are obviously in screen pixels. To be able to reasonably compare the two to calculate whether the pointer is inside or outside I need to first convert the Shape's dimensions into screen pixels.

我在Google上搜索了很多，但是虽然我最初发现了几个很有希望的代码段，但是这些代码段都不起作用(因为大多数Excel和PowerPoint显然具有不同的文档模型).

I googled around a lot, but while I found several at first promising code snippets, none of these worked (as most were for Excel and PowerPoint obviously has a different document model).

有什么好心的人能给我一个提示或参考吗?如何将Shape的尺寸转换为屏幕像素(即，考虑缩放，窗口位置，缩放系数等).

Could some kind soul give me a hint or some reference how to convert a Shape's dimension into screen pixels (i.e. taking scaling, window position, zoom-factor etc. into account).

M.

推荐答案

万一有兴趣的人-在进一步谷歌搜索后，这是我的解决方案:

In case anyone's interested - here is my solution after LOTS of further googling:

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

这篇关于MS PowerPoint:如何将形状的位置和大小转换为屏幕坐标?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！