VB调用CallWindowProc 主窗口卡死
全局变量
dim PreWndProc as long
函数1:
Public Function HOOK窗口过程() As Long
Dim retvalue As Long
PreWndProc = GetWindowLong(mainwnd.hWnd, GWL_WNDPROC)
If PreWndProc <> 0 Then
retvalue = SetWindowLong(mainwnd.hWnd, GWL_WNDPROC, AddressOf NewWndProc)
End If
'这地方其实应该可以直接PreWndProc=setwindowlong（XXXX....）
mainwnd.Text2.Text = CStr(PreWndProc)
End Function
新窗口过程：
Public Function NewWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
CallWindowProc ByVal PreWndProc, ByVal hWnd, ByVal Msg, ByVal wParam, ByVal lParam
’这个地方这么写也错误 CallWindowProc PreWndProc, hWnd, Msg, wParam,lParam
End Function
经测试，只要是一替换窗口过程，窗口就卡死了。。。求高手帮忙解决。先谢了！
[解决办法]
'修改如下：
Public Function NewWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
NewWndProc=CallWindowProc( PreWndProc, hWnd, Msg, wParam,lParam)
End Function
[解决办法]
'Example Name: Killing the Default Textbox Context Menu
'------------------------------------------
'BAS Module Code
'------------------------------------------
Option Explicit
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_CONTEXTMENU As Long = &H7B
Public defWndProc As Long
Public Sub Hook(hwnd As Long)
If defWndProc = 0 Then
defWndProc = SetWindowLong(hwnd, _
GWL_WNDPROC, _
AddressOf WindowProc)
End If
End Sub
Public Sub UnHook(hwnd As Long)
If defWndProc > 0 Then
Call SetWindowLong(hwnd, GWL_WNDPROC, defWndProc)
defWndProc = 0
End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case WM_CONTEXTMENU
'监视上下文菜单消息,并弹出自定义菜单
Form1.PopupMenu Form1.mnuPopup
WindowProc = 1
Case Else
WindowProc = CallWindowProc(defWndProc, _
hwnd, _
uMsg, _
wParam, _
lParam)
End Select
End Function
'------------------------------------------
'Form Code
'------------------------------------------
'在Form中需要一个顶级菜单作为弹出菜单
Option Explicit
Private Sub Form_Load()
Command1.Caption = "Hook Textbox"
Command2.Caption = "Unhook"
End Sub
Private Sub Command1_Click()
Call Hook(Text1.hwnd)
End Sub
Private Sub Command2_Click()
Call UnHook(Text1.hwnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnHook(Text1.hwnd)
End Sub
Private Sub Text1_MouseUp(Button As Integer, _
Shift As Integer, _
X As Single, Y As Single)
'自定义弹出菜单
If defWndProc = 0 Then
If Button = vbRightButton Then
PopupMenu mnuPopup
End If
End If
End Sub
