如何在VBA x64中使用CallWindowProc？
如何在VBA x64中使用CallWindowProc？
提问于 2020-06-04 04:44:56
我想要一个在使用接口的SetWindowLongPtrW和CallWindowProc方面的帮助。
我要在表单中插入菜单，然后需要在窗口中安装一个过程来处理菜单的功能。
在互联网上已经有一个x32运行良好的例子，但在x64上就不行了。我已经对x64中的正确操作做了所有可能的更正，比如使用LongPtr，如果可用的话，还可以使用LongPtr。
表单是打开的，然而，性能很糟糕，它锁定了太多的屏幕。我还注意到VBA窗口的标题疯狂地更新。下面是代码片段。
请记住，菜单创建功能可以完美地工作。当我对SetWindowLongPtr函数进行注释时，除了对VBA过程的调用之外，一切都正常工作。
*** Inside Form Module ***
Private Sub UserForm_Initialize()
g_hForm = FindWindowA(vbNullString, Me.Caption)
Call CreateAPIMenu 'This function works perfectly. It add Menu and submenus.
Call InsertProcedure(g_hForm) 'This Function causes slowing on the window and sometimes, closes excel.
End Sub
*** End Form Module ***
***Standard Module***
Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" ( _
ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Public Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcW" ( _
ByVal lpPrevWndFunc As LongPtr, _
ByVal hWnd As LongPtr, _
ByVal msg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Public Const GWL_WNDPROC = -4
Public Function WinProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
On Error Resume Next
WinProc = CallWindowProc(lOrigWinProc, hWnd, uMsg, wParam, lParam)
End Function
Sub InsertProcedure(myhwnd As LongPtr)
lOrigWinProc = SetWindowLong(myhwnd, GWL_WNDPROC, AddressOf WinProc)
End Sub回答 1
Stack Overflow用户
发布于 2020-06-05 10:39:05
lOrigWinProc似乎是一个局部变量，WinProc中的CallWindowProc(lOrigWinProc, hWnd, uMsg, wParam, lParam)等于CallWindowProc(0, hWnd, uMsg, wParam, lParam)
在模块中声明它之后，它对我有效：
Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" ( _
ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Public Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcW" ( _
ByVal lpPrevWndFunc As LongPtr, _
ByVal hWnd As LongPtr, _
ByVal msg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Public Const GWL_WNDPROC = -4
Public lOrigWinProc As LongPtr
Public Function WinProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
On Error Resume Next
WinProc = CallWindowProc(lOrigWinProc, hWnd, uMsg, wParam, lParam)
End Function
Sub InsertProcedure(ByVal myhwnd As LongPtr)
lOrigWinProc = SetWindowLong(myhwnd, GWL_WNDPROC, AddressOf WinProc)
End Sub结果：
或者，您也可以使用SetWindowSubclass来细分类。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/62182424
复制相关文章
相似问题