MS PowerPoint: как преобразовать положение и размер фигуры в координаты экрана?

Я написал небольшой макрос VBA для PowerPoint (2010 г.), который открывает всплывающее окно с пояснениями при наведении курсора на какую-либо фигуру. Это прекрасно работает. Увы, нет никакого события, которое запускается при выходе из области снова, и поэтому теперь я хочу расширить код так, чтобы он отслеживал область всплывающего окна, и когда указатель покидает эту область, он снова удаляет всплывающее окно.

Но теперь я столкнулся с какой-то глупой проблемой: координаты Shape (.Left, .Top, .Width и .Height) даны в каких-то "единицах документа" (точно не знаю, в какой это единице). Координаты указателя, однако, очевидно, в пикселях экрана. Чтобы иметь возможность разумно сравнить их, чтобы вычислить, находится ли указатель внутри или снаружи, мне нужно сначала преобразовать размеры формы в пиксели экрана.

Я много гуглил, но, хотя я нашел несколько многообещающих фрагментов кода, ни один из них не работал (как и большинство из них для Excel, а PowerPoint, очевидно, имеет другую модель документа).

Может ли какая-нибудь добрая душа дать мне подсказку или ссылку, как преобразовать размер фигуры в пиксели экрана (т.е. с учетом масштабирования, положения окна, коэффициента масштабирования и т. д.).

M.


powerpoint pixels shape
person mmo    schedule 31.01.2013    source источник
comment
Любые указатели, с чего начать, чтобы обнаружить наведение мыши на события?   -  person Cilvic    schedule 24.01.2014

Ответы (2)


arrow_upward
3
arrow_downward

Если кому-то интересно - вот мое решение после МНОГО дальнейшего поиска в Google:

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
...
person mmo    schedule 02.02.2013

arrow_upward
0
arrow_downward

координаты формы (.Left, .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
person Steve Rindsberg    schedule 01.02.2013
comment
Увы, это не работает. Я всегда получаю ошибку «Недопустимое значение». Кажется, что в режиме слайд-шоу ActiveWindow отсутствует. Поэтому я попытался вместо этого использовать ActivePresentation.SlideShowWindow, но этот объект не имеет никакого метода .PointsToScreenPixelsX/Y. Любые идеи? - person mmo; 01.02.2013
comment
Вы все еще можете добраться туда. Режим слайд-шоу заполнит экран вашим слайдом. Вызовы WIN API могут дать вам разрешение экрана или, если вы управляете ПК, вы можете жестко закодировать его, так что это вопрос соотношений; вы знаете положение/размер фигуры на слайде, вы знаете, что ширина слайда 10 становится равной 1024 или сколько угодно пикселей на экране, так что это просто соотношения оттуда. Становится немного сложнее, если пропорции вашего слайд-шоу не соответствуют пропорциям экрана, но это просто добавляет шаг к вычислениям. - person Steve Rindsberg; 01.02.2013
comment
Нет! НЕТ! Мы не делаем такой хрупкий бриколаж, который работает только на одной машине, но не работает на другой. НИ ЗА ЧТО! - person mmo; 02.02.2013