当前位置：首页 > news >正文

使用消息泵让个人窗口项目捕获键盘输入

news 2026/7/11 22:55:55

其实，在第一期创建了对话框窗口之后，这个消息泵就已经可以登场了，原因是这样的：大家尝试下在窗口显示之后打打字，看看字符是不是全部输入到Excel表格当中了，这个现象已经说明了我们的对话框是接收不到键盘输入的。

窗口无法接收键盘输入

这个问题会在后续窗口完善中愈发严重，不管是创建出来用于搜索的编辑框，还是虚拟列表的标头筛选框，都无法输入任何一个字符。

所以，我们本期来一个防患于未然。

VBA消息泵的完整应用

要想让我们的个人窗口能够接收到键盘输入，就必须要用到本期的消息泵。其实，如果你有在百度上搜索关于VBA消息泵的使用案例，那你肯定会发现，这类的文章少的可怜，甚至都找不到......

但没关系，晚间现在就能给你完整使用教学！

1. 必要的API函数和结构声明

#If VBA7 And Win64 Then Private Declare PtrSafe Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long) Private Declare PtrSafe Function GetMessageA Lib "user32" (lpMsg As MSGTYPE, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long Private Declare PtrSafe Function IsDialogMessageA Lib "user32" (ByVal hDlg As LongPtr, lpMsg As MSGTYPE) As Long Private Declare PtrSafe Function TranslateMessage Lib "user32" (lpMsg As MSGTYPE) As Long Private Declare PtrSafe Function DispatchMessageA Lib "user32" (lpMsg As MSGTYPE) As LongPtr #Else Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long) Private Declare Function GetMessageA Lib "user32" (lpMsg As MSGTYPE, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long Private Declare Function IsDialogMessageA Lib "user32" (ByVal hDlg As Long, lpMsg As MSGTYPE) As Long Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSGTYPE) As Long Private Declare Function DispatchMessageA Lib "user32" (lpMsg As MSGTYPE) As Long #End If #If VBA7 And Win64 Then Private Type POINTAPI x As Long y As Long End Type Private Type MSGTYPE hwnd As LongPtr message As Long wParam As LongPtr lParam As LongPtr time As Long pt As POINTAPI End Type #Else Private Type POINTAPI x As Long y As Long End Type Private Type MSGTYPE hwnd As Long message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type #End If

2. 阻塞式消息循环的建立代码

要知道系统消息一次性会产生很多个，像是用户在移动鼠标时会一直产生的移动消息等，它们会被各个窗口捕获并处理。因此，我们需要一个循环来持续的泵取系统消息，分发给我们的对话框窗口。

Dim Gsm As MSGTYPE, Rtu& Do While True Rtu = GetMessageA(Gsm, 0, 0, 0) If Rtu = 0 Or Rtu = -1 Then Exit Do Else If IsDialogMessageA(Ud.Dialog, Gsm) = 0 Then TranslateMessage Gsm DispatchMessageA Gsm End If End If Loop

所以，在代码的最外层，我们添加了一个循环条件永远满足的Do While语句，当代码运行到这里后就会无限的泵取消息。如果循环条件永远满足的话那什么时候结束循环呢？

接着，我们添加了一个叫做GetMessage的函数，这个函数在接收到消息之后会返回一个数值，只有当接收到WM_QUIT消息时会返回零值，当遇到错误时会返回-1（这就是结束循环的方法）；当GetMessage函数返回非零值时，则将该消息转换分发来让当前窗口接收。

3. 阻塞式消息循环的终止代码

PostQuitMessage 0

在这句代码运行之后，我们的消息循环就会因为Rtu=0而结束。

4. 防止中断循环导致弹窗提示（重要）

在进入消息循环之前，你需要忽略VBA默认的中断事件，比如用户连按Esc键或是Ctrl+Break。

'先记录原来的默认值，再赋予新值 Ud.EnableCancelKey = Application.EnableCancelKey Application.EnableCancelKey = xlDisabled

'窗口关闭时恢复原来的默认值 Application.EnableCancelKey = Ud.EnableCancelKey

因为，这些操作会造成代码运行中断的弹窗提示。然而，我们的个人窗口项目又离不开子类化技术，在子类化的过程中一旦遇到代码调试的现象，必定导致程序崩溃！

代码运行中断的弹窗提示