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

Posted 2023-05-07

【中文标题】访问表单子类以捕获 WM_MOVING 消息

【英文标题】：Access Form subclassing to catch WM_MOVING message

【发布时间】：2016-01-03 08:37:13

【问题描述】：

我是这个论坛的新手，所以提前感谢您对这个帖子的帮助。

我正在尝试解决我认为是 Access Forms 的一个古老问题。我正在开发一个数据库，其中一个弹出主窗体打开了几个我希望保留在主窗体边界内的其他弹出窗体。当主窗体移动或调整大小时，我需要相应地移动其他打开的窗体并调整其大小。我基本上是想让我的数据库看起来类似于一个主窗体有多个子窗体的实际应用程序。

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

我已经读过可以对表单进行子类化并将 WM_MOVING 消息捕获到窗口。我为此开发了一些测试代码，但是当我尝试运行它时，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

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

谢谢

【问题讨论】：

你的声明是错误的，nIndex 和 Msg 都是 Long。

【参考方案1】：

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

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

这是一个例子。

在模块中声明以下 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 位环境中工作。 然后，在子 form_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

我只尝试过弹出式表单，所以我不知道它是否也适用于其他表单。但是，如果您将两个表单（父表单和子表单）都设置为弹出表单，您将看到 Windows 自动将子表单与父表单一起移动。您还可以添加子窗体的子窗体，它仍然可以正常工作。

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

我发现使用函数 GetWindowRect 来获取父窗体的坐标然后设置子窗体的位置很有用。

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()事件中

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

一旦你有了主窗体的坐标，你就可以决定在哪里放置你的子窗体。最后，如果要根据父窗体的大小动态调整子窗体的位置，可以使用父窗体的 form_resize() 事件调用子窗体的 form_resize() 事件并更改它们的大小和位置.为了做到这一点，必须将子表单的 form_resize() 声明为 public，然后您可以从任何其他表单（在我们的例子中为父表单）调用它。这样，如果父窗体太小，您可以在子窗体中添加滚动条。

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

干杯

【讨论】：

有趣。您能否在答案中添加一个示例，您如何使用 API 函数？

嗨@Andre，我已经编辑了我的答案并添加了一些代码和解释......我希望它有所帮助！ :)

非常感谢，我一直在处理这个问题，我明天试试，希望它有效！ Access Forms 没有适当的 FormMove 事件，因此您可以轻松地手动重新定位某些对象。我忘记了这个，它似乎隐约熟悉并且非常有意义。