Подскажите, в чем измеряется Width, Heigth, Left, Rigth UserFrom?
Мне нужно было разместить форму на экране. Почитал в чем измеряется формы в VBA, вроде как должно быть в твипах (Твип равен 1/1440 дюйма, о твипах в Википедии -
https://ru.wikipedia.org/wiki/%D0%A2%D0%B2%D0%B8%D0%BF)
На самом деле не в них. Я вышел из положения - нашел сколько пикселей содержится в единицах формы и, умножив это число на количество пикселей, получил нужный мне сдвиг для формы.
Код:
Private Sub CommandButton1_Click()
hwnd = FindWindow("ThunderDFrame", Me.Caption)
relPixelInUnitFormX = Me.Width / GetMyWindowRectSize(hwnd).Width ' пикселей в единице формы по X
relPixelInUnitFormY = Me.Height / GetMyWindowRectSize(hwnd).Height ' пикселей в единице формы по Y
' Размещаю 30 пикселей сверху
Me.Top = 30 * relPixelInUnitFormY
' Размещаю 30 пикселей справа
x = GetSystemMetrics(SM_CXSCREEN)
Me.Left = (GetSystemMetrics(SM_CXSCREEN) - GetMyWindowRectSize(hwnd).Width - 30) * relPixelInUnitFormX
End Sub
где
Код:
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0, SM_CYSCREEN = 1
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
Width As Long
Height As Long
End Type
Public Function GetMyWindowRectSize(hwnWindow) As RECT
'вычисление размера окна в пикселях
Dim a As Long
a = GetWindowRect(hwnWindow, GetMyWindowRectSize)
With GetMyWindowRectSize
.Height = .Bottom - .Top
.Width = .Right - .Left
End With
End Function
Задачу я решил. Но вопрос остался: в чем измеряются UserForm?
Решил исправить код, который будет использоваться в реальном приложении при работе с Office 2010 и выше.
Прежний код не удаляю специально, чтобы была видна разница.
Код:
#If VBA7 Then
Dim hwnd As LongPtr
#Else
Dim hwnd As Long
#End If
Dim relPixelInUnitFormX As Double, relPixelInUnitFormY As Double, SceenSize As Long
hwnd = FindWindow("ThunderDFrame", Me.Caption)
relPixelInUnitFormX = Me.Width / GetMyWindowRectSize(hwnd).Width
relPixelInUnitFormY = Me.Height / GetMyWindowRectSize(hwnd).Height
Me.Top = 30 * relPixelInUnitFormY
SceenSize = GetSystemMetrics(SM_CXSCREEN)
Me.Left = (GetSystemMetrics(SM_CXSCREEN) - GetMyWindowRectSize(hwnd).Width - 30) * relPixelInUnitFormX
Код:
#If VBA7 Then
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
#Else
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
#End If
Public Const SM_CXSCREEN = 0, SM_CYSCREEN = 1
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
Width As Long
Height As Long
End Type
Public Function GetMyWindowRectSize(hwnWindow) As RECT
Dim a As Long
a = GetWindowRect(hwnWindow, GetMyWindowRectSize)
With GetMyWindowRectSize
.Height = .Bottom - .Top
.Width = .Right - .Left
End With
End Function