添加菜單到系統菜單

添加菜單到系統菜單

Private Sub Form_Load()

    OldWindowProc = GetWindowLong(Form1.hwnd, GWL_WNDPROC)
    ' 取得窗口函數的地址
    Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
    ' 用SubClass1_WndMessage代替窗口函數處理消息

    SysMenuHwnd = GetSystemMenu(Form1.hwnd, False)

    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2000, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2001, "關于本程序(&A)")
    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2002, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2003, "恢復系統菜單(&R)")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If OldWindowProc <> GetWindowLong(Form1.hwnd, GWL_WNDPROC) Then
        Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, OldWindowProc)
    End If
End Sub

Option Explicit

' API函數聲明
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 Long
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 ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal
lpDirectory As String, ByVal nShowCmd As Long) As Long

' 常數聲明
Public Const WM_SYSCOMMAND = &H112
' 單擊控制框產生此消息
Public Const MF_SEPARATOR = &H800&
' 為菜單加一條分隔線
Public Const MF_STRING = &H0&
' 在菜單中加一個字符串
Public Const GWL_WNDPROC = (-4)

' 全局變量
Public OldWindowProc As Long
' 保存默認的窗口函數地址
Public SysMenuHwnd As Long
' 保存系統菜單句柄

Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long,
ByVal lp As Long) As Long
    If Msg <> WM_SYSCOMMAND Then
        SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
        ' 如果消息不是WM_SYSCOMMAND，就調用默認的窗口函數處理
        Exit Function
    End If

    Select Case wp
        Case 2001
            Call MsgBox("本程序實現了修改系統菜單的功能  ", vbOKOnly + vbInformation)
        Case 2003
            Call GetSystemMenu(Form1.hwnd, True)
            Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, OldWindowProc)
            Call MsgBox("已經恢復了默認的系統菜單  ", vbOKOnly + vbInformation)
        Case Else
            SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
            Exit Function
    End Select

    SubClass1_WndMessage = True

End Function

       以上代碼來自： 源代碼數據庫(SourceDataBase)
           當前版本： 1.0.538
               作者： Shawls
           個人主頁： Http://Shawls.Yeah.Net
             E-Mail： ShawFile@163.Net
                 QQ： 9181729