API编程高手前来收分

Question

利用字类技术截获窗体消息。如需源程序，请email [email protected]

Answer 1

'如果再控制"系统菜单":
'窗体模块 Form1:
'菜单 系统控制菜单、MenuFile、MenuFileNew
Option Explicit
Private Sub Form_Load()
OldWindowProcFrm = GetWindowLong(Me.hWnd, GWL_WNDPROC)
AppendMenu GetSubMenu(GetMenu(Me.hWnd), 0), MF_STRING, 3001, "MenuAappend"
AppendMenu GetSystemMenu(Me.hWnd, False), MF_STRING, 2001, "SysMenuAppend"
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage
End Sub
Private Sub Form_Unload(Cancel As Integer)
If OldWindowProcFrm <> GetWindowLong(Me.hWnd, GWL_WNDPROC) Then
   SetWindowLong Me.hWnd, GWL_WNDPROC, OldWindowProcFrm
End If
End Sub'标准模块 Module1:
Option Explicit
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As LongPrivate Const WM_COMMAND = &H111
Private Const WM_SYSCOMMAND = &H112Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)Public OldWindowProcFrm As Long
Public Function SubClass1_WndMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
Select Case Msg
       Case WM_COMMAND
            Select Case wp
                   Case 3001
                        MsgBox "MenuAppend"
                        SubClass1_WndMessage = True
                   Case Else
                        SubClass1_WndMessage = CallWindowProc(OldWindowProcFrm, hWnd, Msg, wp, lp)
            End Select
       Case WM_SYSCOMMAND
            Select Case wp
                   Case 2001
                        MsgBox "SysMenyAppend"
                        SubClass1_WndMessage = True
                   Case Else
                        SubClass1_WndMessage = CallWindowProc(OldWindowProcFrm, hWnd, Msg, wp, lp)
            End Select
      Case Else
           SubClass1_WndMessage = CallWindowProc(OldWindowProcFrm, hWnd, Msg, wp, lp)
End Select
End Function