Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lReturn As Long

    
  lReturn = CallWindowProc(OldWndProc, hwnd, Msg, wParam, lParam)
  MsgBox WM_COMMAND
  Select Case Msg
    Case WM_COMMAND
      Select Case LowOrd(wParam)
        Case 2
          MsgBox "О программе..."
        Case 10
          MsgBox "New..."
        Case 20
          MsgBox "Save..."
        Case 30
          MsgBox "Exit..."
      End Select
  End Select
  WindowProc = lReturn
End Function

Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Public Const MF_SEPARATOR = &H800&
Public Const MF_GRAYED = &H1&
Public Const MF_BYCOMMAND = &H0&
Public Const TPM_RETRUNCMD = &H100&
Const GWL_WNDPROC = -4
Const WM_MENUSELECT = &H11F&
Const WM_COMMAND = &H111&
Const WM_CONTEXTMENU = &H7B&
Const WM_MENUBASE = &H2000&

Declare Function CreateMenu Lib "user32" () As Long
Declare Function CreatePopupMenu Lib "user32" () As Long
Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wflags As Long, ByVal wIDNewItem As Long, ByVal lpnewitem As String) As Long
Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wflags As Long, ByVal X As Long, ByVal Y As Long, ByVal nreserved As Long, ByVal hwnd As Long, lprc As Rect) As Long
Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Boolean

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpwindowname As String) 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 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

Function LowOrd(DbleWord As Long) As Integer
    If DbleWord And &H8000& Then
        LowOrd = &H8000 Or (DbleWord And &H7FFF&)
    Else
        LowOrd = DbleWord And &HFFFF&
    End If
End Function

Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lReturn As Long

    
  lReturn = CallWindowProc(OldWndProc, hwnd, Msg, wParam, lParam)
  MsgBox WM_COMMAND
  Select Case Msg
    Case WM_COMMAND
      Select Case LowOrd(wParam)
        Case 2
          MsgBox "Î ïðîãðàììå"
        Case 10
          MsgBox "Ñîçäàòü ïðîôèëü..."
        Case 20
          MsgBox "Íàñòðîèòü ïðîôèëü..."
        Case 30
          MsgBox "Êàòàëîã ïðîôèëåé..."
      End Select
  End Select
  WindowProc = lReturn
End Function
 
Public Sub ActivateSub()
  Dim hMenu As Long
  Dim hPopupMenu As Long
  
  hwnd = FindWindow(vbNullString, "UserForm1")
  hMenu = CreateMenu()
  hPopupMenu = CreatePopupMenu()
  AppendMenu hMenu, MF_STRING Or MF_POPUP, hPopupMenu, "File"
  AppendMenu hMenu, MF_STRING, 2, "About"
  AppendMenu hPopupMenu, MF_STRING, 10, "New"
  AppendMenu hPopupMenu, MF_STRING, 20, "Save"
  AppendMenu hPopupMenu, MF_SEPARATOR, 600, ""
  AppendMenu hPopupMenu, MF_STRING, 30, "Exit"
  SetMenu hwnd, hMenu
  OldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub DeactivateSub()
  SetWindowLong hwnd, GWL_WNDPROC, OldWndProc
End Sub