Option Explicit

Private m_wndprcNext As Long
Private Const IDM_INCR As Long = 1000

Private Sub SubClass()
  UnSubClass
  Debug.Assert GetWindowLong(hWnd, GWL_USERDATA) = 0
  SetWindowLong hWnd, GWL_USERDATA, ObjPtr(Me)
  m_wndprcNext = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf frmProc)
End Sub

Private Sub UnSubClass()
  If m_wndprcNext Then
    SetWindowLong hWnd, GWL_WNDPROC, m_wndprcNext
    SetWindowLong hWnd, GWL_USERDATA, 0&
    m_wndprcNext = 0
  End If
End Sub
Friend Function WindowProc _
 (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long,  _
  ByVal lParam As Long) As Long
    Dim hSysMenu As Long
    Static c As Integer

    Select Case uMsg
    Case WM_INITMENUPOPUP
      If lParam \ 65535 And &HFFFF& Then 'HIWORD of lparam
	hSysMenu = GetSystemMenu(hWnd, 0)
	If wParam = hSysMenu Then
	  EnableMenuItem _
	  hSysMenu, IDM_INCR, ByVal IIf _
	    (WindowState = vbMinimized, MF_GRAYED, 0)
	End If
      End If
    Case WM_SYSCOMMAND
      Select Case wParam
      Case IDM_INCR
	c = c + 1
	lblCount.Caption = CStr(c) & "回目"
      End Select
    End Select
    WindowProc = CallWindowProc _
    (m_wndprcNext, hWnd, uMsg, wParam, ByVal lParam)
End Function

Private Sub Command1_Click()
  Dim frm1 As New Form1
  frm1.Show
End Sub

Private Sub Form_Load()
  AppendMenu GetSystemMenu(hWnd, 0), MF_SEPARATOR, 0&, 0&
  AppendMenu GetSystemMenu(hWnd, 0), MF_STRING, IDM_INCR, "&Incriment"
  SubClass
End Sub

Private Sub Form_Unload(Cancel As Integer)
  UnSubClass
End Sub