systemmenu.frm

此源码为vb圣经编码

VERSION 5.00
Begin VB.Form frmSystemMenu 
   Caption         =   "SystemMenu Subclassing Sample"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   ClipControls    =   0   'False
   HasDC           =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmSystemMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'***************************************************************
Option Explicit
Private Const IDM_ABOUT As Long = 1000
Private m_SubClassMain As SubClassData
Private Sub Form_Load()
Dim hWnd As Long
    hWnd = Me.hWnd
    AppendMenu GetSystemMenu(hWnd, 0), MF_SEPARATOR, 0&, 0&
    AppendMenu GetSystemMenu(hWnd, 0), MF_STRING, IDM_ABOUT, "&About..."
    SubClass m_SubClassMain, hWnd, ObjPtr(Me), AddressOf RedirectSystemMenuWindowProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
    UnSubClass m_SubClassMain, Me.hWnd
End Sub
Private Sub Form_Paint()
    CurrentX = 0
    CurrentY = 0
    Print "Choose About... on the system menu"
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
Dim MenuFlags As Long
    Select Case uMsg
        Case WM_INITMENUPOPUP
            If (lParam And &HFFFF0000) \ &HFFFF& And &HFFFF& Then  'HIWORD of lparam
                hSysMenu = GetSystemMenu(hWnd, 0)
                If wParam = hSysMenu Then
                    If WindowState = vbMinimized Then MenuFlags = MF_GRAYED
                    EnableMenuItem hSysMenu, IDM_ABOUT, MenuFlags
                End If
            End If
        Case WM_SYSCOMMAND
            Select Case wParam
                Case IDM_ABOUT
                    MsgBox "About box from system menu."
            End Select
    End Select
    WindowProc = CallWindowProc(m_SubClassMain.wndprocNext, hWnd, uMsg, wParam, lParam)
End Function