如何获取用户窗体的边框大小？

Question

我有一个带有多个控件的用户窗体（userform1）。一个控件是一个命令按钮，它将打开第二个用户窗体 (userform2)。

\n\n

我希望 userform2 立即在按钮下方打开并以其为中心。

\n\n

为了无论​​ Windows 的系统/主题定义如何都具有相同的行为，我需要知道 userform1 边框的大小。

\n\n

经过3天的挖掘，我使用了API函数GetWindowRect和GetWindowClient。通过这两个 API 例程，我可以找到水平边框（上加下）和垂直边框（左加右）的总尺寸，但不能单独找到它们。

\n\n

对于垂直边框，常识是它们将具有相同的厚度（宽度） \xe2\x80\x94 事实上，我\xe2\x80\x99 从未见过左右边框不同的窗口。因此，解决方案是将总大小除以 2。然而，对于水平边框，这不能使用，因为上边框通常比下边框厚。

\n\n

最终，我找到了解决该问题的方法，但它并不总是适用。也就是说，如果userform1内部有frame控件，那么可以使用API​​函数GetWindowRect来查找frame的\xe2\x80\x9cabsolute\xe2\x80\x9d坐标，即参考屏幕，而不是userform1 。然后，上边框大小由以下公式给出：frame.top_Absolute \xe2\x80\x93 (Userform1.top_Absolute - frame.top_RelativeToUserform1)。

\n\n

这种方法的问题是，用户窗体并不总是具有框架控件。另一方面，并​​非所有控件都具有 \xe2\x80\x9crectangle\xe2\x80\x9d 属性；因此，GetWindowRect 不能用于所有控件。

\n\n

问题：是否有 \xe2\x80\x9cdirect\xe2\x80\x9d 方法来查找用户窗体边框的大小？

\n\n

代码

\n\n

在普通模块中：

\n\n

Option Explicit\n\n\'API Declarations\n\n#If VBA7 Then\nDeclare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long\nDeclare PtrSafe Function GetDC Lib "user32" (ByVal hWnD As Long) As Long\nDeclare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnD As Long, ByVal hDC As Long) As Long\nDeclare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long\nDeclare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long\nDeclare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long\nDeclare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long\n#Else\nDeclare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long\nDeclare Function GetDC Lib "user32" (ByVal hWnD As Long) As Long\nDeclare Function ReleaseDC Lib "user32" (ByVal hWnD As Long, ByVal hDC As Long) As Long\nDeclare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long\nDeclare Function GetWindowRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long\nDeclare Function GetClientRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long\nDeclare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long\n#End If\n\nType udtRECT\n    Left As Long\n    Top As Long\n    Right As Long\n    Bottom As Long\nEnd Type\n\nPublic Type BorderSize\n    TopHeight As Long\n    LeftWidth As Long\n    BottomHeight As Long\n    RightWidth As Long\nEnd Type\n\nPublic FormBorders As BorderSize\n\n\'To determine the sizes of the borders\n\nPublic Sub GetFormBorders(ByVal FormHandler As Long, ByVal FrameHandler As Long)\n\nDim rectForm As udtRECT\nDim rectFrame As udtRECT\nDim rectClientForm As udtRECT\nDim Trash As Long\n\nTrash = GetWindowRect(FormHandler, rectForm)\nTrash = GetWindowRect(FrameHandler, rectFrame)\nTrash = GetClientRect(FormHandler, rectClientForm)\n\nFormBorders.TopHeight = ConvertPixelsToPoints(rectFrame.Top - rectForm.Top, "Y") - frmFlyschGSI.fraRockProp.Top         \'userform1.frame.top\nFormBorders.LeftWidth = ConvertPixelsToPoints(rectFrame.Left - rectForm.Left, "X") - frmFlyschGSI.fraRockProp.Left\nFormBorders.BottomHeight = ConvertPixelsToPoints(rectForm.Bottom - rectForm.Top, "Y") - FormBorders.TopHeight - _\n                           ConvertPixelsToPoints(rectClientForm.Bottom - rectClientForm.Top, "Y")\nFormBorders.RightWidth = ConvertPixelsToPoints(rectForm.Right - rectForm.Left, "X") - FormBorders.LeftWidth - _\n                         ConvertPixelsToPoints(rectClientForm.Right - rectClientForm.Left, "X")\n\nDebug.Print FormBorders.TopHeight, FormBorders.LeftWidth, FormBorders.BottomHeight, FormBorders.RightWidth\n\nEnd Sub\n\n\'To convert pixels to points\n\nPublic Function ConvertPixelsToPoints(ByVal sngPixels As Single, ByVal sXorY As String) As Single\n\n\'Credits to: https://bettersolutions.com/vba/userforms/positioning.htm\n\nDim hDC As Long\n\nhDC = GetDC(0)\n\nIf sXorY = "X" Then\n    ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88))\nEnd If\n\nIf sXorY = "Y" Then\n    ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90))\nEnd If\n\nCall ReleaseDC(0, hDC)\n\nEnd Function\n

\n\n

\'在用户表单代码表中：

\n\n

Option Explicit\n\n\nPrivate Sub UserForm_Initialize()\n\n\'Some code here\n\nIf Me.Visible = False Then\n    Call GetFormBorders(FindWindow(vbNullString, frmFlyschGSI.Caption), frmFlyschGSI.fraRockProp.[_GethWnd])\nEnd If\n\n\'More code here\n\nEnd Sub\n\n\nPrivate Sub cmdMiHarder_Click()\n\nDim FrameBorder As udtRECT\nDim Trash As Long\nDim sngTopBorder As Single\nDim sngLeftBorder As Single\n\n\'Some code here\n\nTrash = GetWindowRect(Me.fraRockProp.[_GethWnd], FrameBorder)\n\nsngTopBorder = ConvertPixelsToPoints(FrameBorder.Top, "Y") - (Me.Top + Me.fraRockProp.Top)\nsngLeftBorder = ConvertPixelsToPoints(FrameBorder.Left, "X") - (Me.Left + Me.fraRockProp.Left)\n\n\'More code here\n\nEnd Sub\n

\n

Answer 1

逻辑：

1. 将 Userform1 显示为无模式。这是必需的，以便 Userform2 可以显示为无模式
2. 将 Userform2 显示为无模式。这是必需的，以便可以移动 Userform2
3. 将Userform2移动到相关位置

新位置计算：

可以通过下图更好地解释

在模块中：

Option Explicit

Sub Sample()
    UserForm1.Show vbModeless
End Sub

在Userform1代码区：

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, 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 SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Const HWND_TOP = 0
Private Const SWP_NOSIZE = &H1

Private Sub CommandButton1_Click()
    RepositionForm UserForm2, CommandButton1
End Sub

Public Sub RepositionForm(f As Object, c As Object)
    Dim P As POINTAPI
    Dim meHwnd As Long, hwnd As Long

    meHwnd = FindWindow(vbNullString, Me.Caption)

    P.x = (c.Left - (f.Width / 4)) / PointsPerPixelX
    P.y = (c.Top + c.Height) / PointsPerPixelY

    '~~> The ClientToScreen function converts the client coordinates
    '~~> of a specified point to screen coordinates.
    ClientToScreen meHwnd, P

    UserForm2.Show vbModeless

    '~~> Get Handle of Userform2
    hwnd = FindWindow("ThunderDFrame", "UserForm2")

    '~~> Move the form to relevant location
    SetWindowPos hwnd, HWND_TOP, P.x, P.y, 0, 0, SWP_NOSIZE
End Sub

Private Function PointsPerPixelX() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    PointsPerPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
    ReleaseDC 0, hDC
End Function

Public Function PointsPerPixelY() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    PointsPerPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
    ReleaseDC 0, hDC
End Function

截屏