Question

我正在尝试在屏幕打开时更改其在屏幕上的位置。我希望它比现在更接近屏幕顶部。

我已关闭表单的“自动中心”属性，并查看了所使用的默认值（请注意，这是一个模式弹出窗体）。

Debug.Print "Left: " & Me.WindowLeft; vbCrLf; _
            "Top: " & Me.WindowTop; vbCrLf; _
            "Height: " & Me.WindowHeight; vbCrLf; _
            "Width: " & Me.WindowWidth; vbCrLf & vbCrLf

这为我的特定表单提供了以下输出：

Left: 0
Top: 0
Height: 4140
Width: 15540

所以我假设如果我想打开靠近屏幕顶部的表单，我需要将Top值设为负值。

我尝试了各种消极和积极的价值观，但他们都没有改变形式;我知道这些值是“缇”，所以使用相对于高度和宽度显示的值;大约-4000看起来是我需要的top。

同样，当我设置top值时，上面的Debug.Print显示top的值确实已更改为我指定的值，但表单神秘地保持在屏幕。

我错过了什么？

Answer 1

以下是从缇转换为像素的几个函数

Public Const LOGPIXELSX = 88        '  Píxeles/pulgadas lógicas en X
Public Const LOGPIXELSY = 90        '  Píxeles/pulgadas lógicas en Y
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long

'Emulate the VB property Screen.TwipsPerPixelX
Public Function TwipsPerPixelX() As Integer
Dim hWnd As Long
Dim hdc As Long
Dim Pixels As Integer
   hWnd = GetDesktopWindow
   hdc = GetDC(hWnd)
   Pixels = GetDeviceCaps(hdc, LOGPIXELSX)
   TwipsPerPixelX = 1440 / Pixels
   ReleaseDC hWnd, hdc
End Function
'Emulate the VB property Screen.TwipsPerPixelY
Public Function TwipsPerPixelY() As Integer
Dim hWnd As Long
Dim hdc As Long
Dim Pixels As Integer
   hWnd = GetDesktopWindow
   hdc = GetDC(hWnd)
   Pixels = GetDeviceCaps(hdc, LOGPIXELSY)
   TwipsPerPixelY = 1440 / Pixels
   ReleaseDC hWnd, hdc
End Function

如果设置Top，Left，...属性不起作用，则可能需要使用SetWindowPos API函数

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 HWND_BOTTOM = 1
Private Const HWND_BROADCAST = &HFFFF&
Private Const HWND_DESKTOP = 0
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
Private Const SWP_FRAMECHANGED = &H20        '  Cambió el marco: enviar WM_NCCALCSIZE
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200      '  No usar el orden Z del propietario
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_SHOWWINDOW = &H40

以下是调整表单大小的示例（在您的情况下，删除SWP_NOMOVE标志，设置顶部和左侧参数并调整宽度和高度计算）

Public Sub ChangeWindowSize(ByVal hWnd As Long, Optional ByVal Height As Variant, Optional ByVal Width As Variant)
Dim rcWindow As RECT
Dim rcClient As RECT
Dim DifAlto  As Long
Dim DifAncho As Long

    GetWindowRect hWnd, rcWindow
    GetClientRect hWnd, rcClient
    DifAlto = (rcWindow.Bottom - rcWindow.Top) - rcClient.Bottom
    DifAncho = (rcWindow.Right - rcWindow.Left) - rcClient.Right

    If IsMissing(Height) Then
        Alto = rcClient.Bottom * TwipsPerPixelY()
    End If
    If IsMissing(Width) Then
        Width = rcClient.Right * TwipsPerPixelX()
    End If

    Width = Width / TwipsPerPixelX() + DifAncho  'Convert from twips to pixels and add the borders
    Height = Height / TwipsPerPixelX() + DifAlto  'Convert from twips to pixels and add the borders and caption
    SetWindowPos hWnd, HWND_TOP, 0, 0, Width, Height, SWP_NOMOVE + SWP_NOZORDER
End Sub

移动方法不改变表单中的表单位置打开事件

1 个答案: