Public Class frmMain

    Friend Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Int32, ByVal nIndex As Int32, ByVal dwNewLong As Int32) As Int32
    Friend Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Int32, ByVal nIndex As Int32, ByVal dwNewLong As DWindowProc) As Int32
    Friend Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Int32, ByVal hwnd As Int32, ByVal Msg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
    Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Int32, ByVal wFlags As Int32, ByVal X As Int32, ByVal Y As Int32, ByVal nReserved As Int32, ByVal hwnd As Int32, ByVal lprc As Rectangle) As Int32
    Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As Point) As Int32
    Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Int32, ByVal bRevert As Int32) As Int32

    Friend Delegate Function DWindowProc(ByVal hwnd As Int32, ByVal iMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
    Dim DWP As DWindowProc

    Friend ProcOld As Int32
    Friend Const TPM_LEFTALIGN = &H0
    Friend Const WM_SYSCOMMAND = &H112
    Friend Const MF_SEPARATOR = &H800
    Friend Const MF_STRING = &H0
    Friend Const GWL_WNDPROC = (-4)
    Friend Const IDM_ABOUT As Int32 = 1010
    Friend Const WM_COMMAND = &H111
    Friend lRet As Int32

    Friend Sub ShowSystemMenu(ByVal hwnd As Int32)
        Dim r As Rectangle
        Dim p As Point
        GetCursorPos(p)
        TrackPopupMenu(GetSystemMenu(hwnd, 0&), 0, p.X, p.Y, 0, hwnd, r)
    End Sub

    Friend Function WindowProc(ByVal hwnd As Int32, ByVal iMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
        Select Case iMsg
            Case WM_SYSCOMMAND
                If wParam = IDM_ABOUT Then
                    MsgBox("VB Web Append to System Menu Example", vbInformation, "About")
                    Return 0
                End If
            Case WM_COMMAND
                CallWindowProc(ProcOld, hwnd, WM_SYSCOMMAND, wParam, lParam)
                WindowProc = 0
                Return 0
        End Select
        Return CallWindowProc(ProcOld, hwnd, iMsg, wParam, lParam)
    End Function

    Private Sub frmMain_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            ShowSystemMenu(Me.Handle)
        End If
    End Sub

    Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        DWP = AddressOf WindowProc '防止垃圾回收自动卸载委托
        ProcOld = SetWindowLong(Me.Handle, GWL_WNDPROC, DWP)
    End Sub

    Private Sub frmMain_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
        SetWindowLong(Me.Handle, GWL_WNDPROC, ProcOld)
    End Sub

End Class