访问表单子类化以捕获 WM_MOVING 消息

Question

我是这个论坛的新手，所以在此先感谢您对这个话题的帮助。

我正在尝试解决我认为是 Access Forms 的 age-old 问题。我正在开发一个数据库，其中 pop-up 主窗体打开其他几个 pop-up 窗体，我希望它们保留在主窗体的边界内。当主窗体移动或调整大小时，我需要相应地移动和调整其他打开的窗体的大小。我基本上是想让我的数据库看起来像一个主窗体有多个 child 窗体的真实应用程序。

我正在使用事件 Detail_Paint() 来检测何时更改主窗体的大小以调整其他窗体的大小，它似乎有效。但是，没有与表单屏幕上的移动相关联的事件。 MouseMove() 似乎不起作用，因为当用户在表单标题上移动鼠标光标时，它不会触发。我已经使用计时器解决了这个问题，该计时器每 10 毫秒检查一次主窗体的位置并相应地更改其他窗体的位置。但是，这会造成令人讨厌的显示器闪烁，并且还会在用户在控件中输入文本时出现问题。

我读到可以将表单子类化并将 WM_MOVING 消息捕获到 window。我为此开发了一些测试代码，但是当我尝试运行它时，Access 停止工作，我必须使用任务管理器将其关闭。我在 Windows 10 64 位系统上使用 Access 2016 Professional 64 位。

这是我到目前为止编写的代码。

' This code goes into a general module (mdl_subclass)
' When subclassing shows the coordinates of the window in its caption

Option Explicit

Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias     "SetWindowLongPtrA" _
        (ByVal hWnd As LongPtr, _
         ByVal nIndex As LongPtr, _
         ByVal dwNewLong As LongPtr) As LongPtr

Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
        (ByVal lpPrevWndFunc As LongPtr, _
         ByVal hWnd As LongPtr, _
         ByVal Msg As LongPtr, _
         ByVal wParam As LongPtr, _
         ByVal lParam As LongPtr) As LongPtr

Public Const GWL_WNDPROC = (-4)
Private Const WM_MOVE = &H3

Dim m_PrevProc As LongPtr

Public Sub SubClass_On(ByVal hWnd As Long)
  m_PrevProc = SetWindowLongPtr(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub SubClass_Off(ByVal hWnd As Long)
  SetWindowLongPtr hWnd, GWL_WNDPROC, m_PrevProc
End Sub

Private Function WindowProc(ByVal hWnd As LongPtr, ByVal uMsg As LongPtr,      ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

  WindowProc = CallWindowProc(m_PrevProc, hWnd, uMsg, wParam, lParam)

  If uMsg = WM_MOVE Then

    Form_frm_main.Me_OnMove lParam And CLng(&HFFFF&), lParam \   CLng(&HFFFF&)

  End If

End Function


' This code instead goes into the form module, starts subclassing on form   loading and stop subclassing on form unload

Private Sub Form_Load()

  SubClass_On Me.hWnd

End Sub

Private Sub Form_Unload(Cancel As Integer)

  SubClass_Off Me.hWnd

End Sub


Friend Sub Me_OnMove(ByVal xPos As Long, ByVal yPos As Long)

  Me.Caption = "x=" & xPos & "; y=" & yPos

End Sub

...关于如何修复我的代码的任何想法？或者对我的问题有任何替代建议吗？

谢谢

Answer 1

我想我已经找到了解决问题的方法！我试图重新创建的是一个带有 Access Forms 的 MDI 应用程序环境。我找到了一个 API 函数，它允许将表单的属性设置为 child。函数是SetParent().

如果您尝试在任何访问表单的 Form_Open() 事件中使用此函数，它将将该表单视为任何其他指定表单的 child。一旦设置了 child 属性，Windows 将自动将 child 表单与主表单一起移动到屏幕上的任何位置。效果很好！

这是一个例子。

在模块中声明以下 WinAPI 函数

Public Declare PtrSafe Function SetParent Lib "user32" _
                               (ByVal hWndChild As LongPtr, _
                                ByVal hWndParent As LongPtr) As Long

Public Declare PtrSafe Function SetWindowPos Lib "user32" _
                               (ByVal hwnd As LongPtr, _
                                ByVal hWndInsertAfter As LongPtr, _
                                ByVal x As Long, _
                                ByVal y As Long, _
                                ByVal cx As Long, _
                                ByVal cy As Long, _
                                ByVal wFlags As Long) As Long

注意我使用 LongPtr 是因为我在 64 位环境中工作。然后，在childform_open事件中，使用下面的代码

Private Sub Form_open(Cancel As Integer)

  Dim hWndParent As LongPtr
  Dim hWndChild As LongPtr

  hWndParent = Form_frm_parent.hwnd
  hWndChild = Form_frm_child.hwnd

  SetParent hWndChild, hWndParent   ' open the form as a child

                                    ' this is used to position the form
  SetWindowPos hWndChild, hWndParent, 163, 44, 725, 437, &H4

End sub

我只尝试过 pop-up 表格，所以我不知道它是否也适用于其他表格。但是，如果您将两种形式（parent 和 child）设置为 pop-up 形式，您将看到 Windows 将 child 形式与 parent 自动形成。您还可以添加 child 的 child 形式，它仍然可以很好地工作。

但是，一旦您将表单声明为 child，命令 docmd.move 会产生一些奇怪的效果。更好的方法是使用 WinAPI 函数 SetWindowPos 来定位您的 child 窗体。坐标系将相对于 parent 形式的位置。所以0,0坐标是parent形式的top-left角。

我发现使用函数 GetWindowRect 获取 parent 表单的坐标然后设置 child 表单的位置很有用。

Public Type RECT
    wdw_left As Long
    wdw_top As Long
    wdw_right As Long
    wdw_bottom As Long
End Type

Public Declare PtrSafe Function GetWindowRect Lib "user32" _
                               (ByVal hwnd As LongPtr, _
                                lpRect As RECT) As Long

然后在 form_resize() 事件中 child 表单

Dim hWndParent As LongPtr   ' handle finestra
Dim hWndChild As LongPtr    ' handle finestra
Dim mainRECT As RECT        ' coordinate form_home (struct RECT)

hWndParent = Form_frm_parent.hwnd
hWndChild = Form_frm_child.hwnd

GetWindowRect hWndParent, mainRECT

一旦您获得了主窗体的坐标，您就可以决定将 child 窗体放置在何处。最后，如果您想根据 parent 表单的大小动态调整 child 表单的位置，您可以使用 parent 表单的 form_resize() 事件来调用 child 表单的 form_resize() 事件并更改它们的大小和位置。为了做到这一点 child 形式的 form_resize() 必须声明为 public，然后你可以从任何其他形式调用它（在我们的例子中是 parent 形式).如果 parent 表单太小，您可以通过这种方式向 child 表单添加滚动条。

我希望这对任何其他对此类解决方案感兴趣的用户有所帮助。

干杯

访问表单子类化以捕获 WM_MOVING 消息

Access Form subclassing to catch WM_MOVING message

forms

64-bit

ms-access

vba