Win 10 Excel 2016 Необъяснимый коэффициент PixelsToPoints для позиционирования пользовательской формы - PullRequest
Новая
       33

Win 10 Excel 2016 Необъяснимый коэффициент PixelsToPoints для позиционирования пользовательской формы

0 голосов
/ 07 июня 2018

Преамбула

При попытке поместить пользовательскую форму в определенную позицию пикселя (сохраненную в структуре типа POINTAPI), необходимо преобразовать координаты пикселя в координаты точки, чтобы иметь возможностьустановить свойства UserForm.Left и UserForm.Top VBA.Давайте назовем этот коэффициент K.

Из моих тестов я понял, что в моем случае GetWindowRect и свойства позиционирования VBA пользовательской формы (Left, Top, Width, Height) включает тени вокруг окна (класса «ThunderDFrame»), содержащие элемент управления MSForm UserForm.Чтобы действительно получить прямоугольник окна, ограниченного границами, необходимо использовать DwnGetWindowAttribute(hWnd, DWMWA_EXTENDED_FRAME_BOUNDS, rcOutRECT, LenB(rcOutRECT) Win API.

Источником системы координат для позиционирования пользовательской формы является пиксель (0; 0), поэтому нет необходимостибеспокоиться о ActiveWindow.PointsToScreenPixelsX / ActiveWindow.PointsToScreenPixelsY и смещении между верхним левым углом окна Excel и верхним левым углом сетки рабочего листа (по крайней мере, до тех пор, пока не вступят в действие свойства Range.Left, Range.Top и т. д.),Тем не менее, интересно отметить, что ActiveWindow.PointsToScreenPixelsX не ведет себя как ActiveWindow.ActivePane.PointsToScreenPixelsX.Первый работает с пикселями, а не с точками ввода, как второй.Настоящее имя метода должно быть скорее ActiveWindow.WorksheetPixelsXToScreenPixelsX.Вы можете легко проверить это: 

ActiveWindow.PointsToScreenPixelsX(1) - ActiveWindow.PointsToScreenPixelsX(0)

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

Задача

Учитывая коэффициент масштабирования, равный 1, для упрощения моего примера MCV, коэффициенты для определенияСвойства .Left и .Top в точках пользовательской формы из позиции (x; y) в пикселях экрана, в которой мы хотим, чтобы она отображалась, должны быть: 

72 / GetDeviceCaps(GetDC(0), LOGPIXELSX)
72 / GetDeviceCaps(GetDC(0), LOGPIXELSY)

, что составляет

  • 0,75 для устаревшего дисплея с разрешением 96 DPI (я пробовал его на ПК с Win 7 + Excel 2007
  • 0,375 с моим планшетом Surface Pro 4, работающим на 64-битной Win 10, с 32-битной Excel 2016

Теперь проблема заключается в том, что на моем планшете приведенный выше расчет возвращает 0,375, правильный коэффициент для позиционирования пользовательской формы в заданной позиции в пикселях (получено из GetCursorPos WinAPI, например) путем преобразования его в соответствующую позицию Point равно 0,35 . Я понятия не имею, откуда это значение ... ???

Текущий прогресс

На планшете:

reg key HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI обозначает 192 и 72 / 192 = 0.375

Я также попробовал некоторые функции из справочника с высоким разрешением в MSDN в справочном интерфейсе Windows Destop App:

  • GetDPIForWindow (я пытался использовать дескриптор окна Application.Hwnd и UserForm)
  • GetDPIForMonitor

, но все по праву возвращает 192.

Минимальное, Полный и проверяемый пример

Следующее позволяет мне получить загадочный коэффициент K = 0,35 на моем планшете, но возвращает 0,75 на другом компьютере, как и ожидалось.

Module1.bas 

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, rcWindowRect As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" (ptCursorPoint As POINTAPI) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Sub test()
    Dim rcUsfWindowRect As RECT
    UserForm1.Show vbModeless
    lRet& = GetWindowRect(UserForm1.hWnd, rcUsfWindowRect)
    dblUsfRectWidth# = rcUsfWindowRect.Right - rcUsfWindowRect.Left
    dblUsfRectHeight# = rcUsfWindowRect.Bottom - rcUsfWindowRect.Top
    Debug.Print UserForm1.Width / dblUsfRectWidth
End Sub

UserForm1 

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public hWnd As Long

Private Sub UserForm_Initialize()
    hWnd = FindWindowA("ThunderDFrame", UserForm1.Caption)
End Sub
...