谁会用AppendMenu这个API函数
谁会用AppendMenu这个API函数，说的详细点，我想在指定的菜单条目下添加一菜单项，并把新菜单项加入代码，应该怎样实现？应该用到那些API函数呢，热心网友帮忙说一下，先谢谢了例子
'Example Name:Changing and Responding to a Modified System Menu
'------------------------------------------------------------------------------
'
' BAS Moduel Code
'
'------------------------------------------------------------------------------
Option Explicit
' MHookMe.bas
'
' Copyright (C)1997 Karl E. Peterson and Zane Thomas, All Rights Reserved
' Distributed by Mabry Software, http://www.mabry.com
'
' Used at VBnet by permission.
' For the latest version see the Tools section at http://www.mvps.org/vb/
' *************************************************************************
' Warning: This computer program is protected by copyright law and
' international treaties. Unauthorized reproduction or distribution
' of this program, or any portion of it, may result in severe civil
' and criminal penalties, and will be prosecuted to the maximum
' extent possible under the law.
' *************************************************************************
Public Declare Function GetProp Lib "User32" _
Alias "GetPropA" _
(ByVal hWnd As Long, ByVal lpString As String) 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
Private Declare Function SetProp Lib "User32" _
Alias "SetPropA" _
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal hData As Long) As Long
Private Declare Function SetWindowLong Lib "User32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal wNewWord As Long) As Long
Private Declare Function GetWindowLong Lib "User32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Const GWL_WNDPROC As Long = (-4)
Public Function HookFunc(ByVal hWnd As Long, ByVal msg As Long, _
ByVal wp As Long, ByVal lp As Long) As Long
'this MUST be dimmed as the object passed!!!
Dim obj As frmMain
Dim foo As Long
foo = GetProp(hWnd, "ObjectPointer")
'Ignore "impossible" bogus case
If (foo <> 0) Then
CopyMemory obj, foo, 4
On Error Resume Next
HookFunc = obj.WindowProc(hWnd, msg, wp, lp)
If (Err) Then
UnhookWindow hWnd
Debug.Print "Unhook on Error, #"; CStr(Err.Number)
Debug.Print " Desc: "; Err.Description
Debug.Print " Message, hWnd: &h"; Hex(hWnd), _
"Msg: &h"; Hex(msg), "Params:"; wp; lp
End If
'Make sure we don't get any foo->Release() calls
foo = 0
CopyMemory obj, foo, 4
End If
End Function
Public Sub HookWindow(hWnd As Long, thing As Object)
Dim foo As Long
CopyMemory foo, thing, 4
Call SetProp(hWnd, "ObjectPointer", foo)
Call SetProp(hWnd, "OldWindowProc", GetWindowLong(hWnd, GWL_WNDPROC))
Call SetWindowLong(hWnd, GWL_WNDPROC, AddressOf HookFunc)
End Sub
Public Sub UnhookWindow(hWnd As Long)
Dim foo As Long
foo = GetProp(hWnd, "OldWindowProc")
If (foo <> 0) Then
Call SetWindowLong(hWnd, GWL_WNDPROC, foo)
End If
End Sub
Public Function InvokeWindowProc(hWnd As Long, msg As Long, _
wp As Long, lp As Long) As Long
InvokeWindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), _
hWnd, msg, wp, lp)
End Function
'------------------------------------------------------------------------------
'
' Form Code
'
'------------------------------------------------------------------------------
Option Explicit
Private Const MF_STRING = &H0
Private Const WM_SYSCOMMAND = &H112
Private Const MF_SEPARATOR = &H800
'required: ID number for About command
'to be added to the system menu. This
'number must be less than '61440 int
'(&HF000 long)
Private Const ID_ABOUT = 1000
Private Declare Function GetSystemMenu Lib "User32" _
(ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private 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
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim r As Long
Dim hMenu As Long
'Add an "About" command to the system menu
hMenu = GetSystemMenu(Me.hWnd, False)
r = AppendMenu(hMenu, MF_SEPARATOR, 0, 0&)
r = AppendMenu(hMenu, MF_STRING, ID_ABOUT, "&About this Demo...")
'if OK, then subclass the form to
'catch this menuitem selection
If r = 1 Then
Label1.Caption = "Select About... from the system menu."
Call HookWindow(Me.hWnd, Me)
Else
Label1.Caption = "About... was not added to the menu."
End If
End Sub
Friend Function WindowProc(hWnd As Long, msg As Long, wp As Long, lp As Long) As Long
Select Case msg
Case WM_SYSCOMMAND
If wp = ID_ABOUT Then
'show the about form
frmAbout.Show vbModal
WindowProc = 1
Exit Function
End If
Case Else
End Select
' Pass along to default window procedure.
WindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), hWnd, msg, wp, lp)
End Function
Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindow(Me.hWnd)
End Sub
Private Sub cmdService_Click()
Dim ChangePackageCaption As String
Dim ChangePackageEnabled As Boolean
' Dim NewServiceCaption As String
Dim NewServiceEnabled As Boolean
' Dim InitialConnectionCaption As String
Dim InitialConnectionEnabled As Boolean
Dim BackDateCaption As String
Dim BackDateEnabled As Boolean
Dim ForwardDateCaption As String
Dim ForwardDateEnabled As Boolean
Dim ReverseCaption As String
Dim ReverseEnables As Boolean
Dim hMenu As Long
Dim iClick As Long
Dim pt As POINTAPI
ChangePackageCaption = ChangePackage
BackDateCaption = BackDateConnection
ForwardDateCaption = ForwardDateDisconnection
ReverseCaption = ReverseDisconnection
hMenu = CreatePopupMenu()
If vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), ChangePackageCol) = "" Then
If vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), InitialConnectCol) = "" And vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), BackDateCol) = "" Then
NewServiceEnabled = True
End If
If vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), InitialConnectCol) <> "" Then
InitialConnectionEnabled = True
End If
If vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), BackDateCol) <> "" Then
BackDateEnabled = True
BackDateCaption = BackDateConnection & " [" & vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), BackDateCol) & "]"
End If
If vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), ForwardDateCol) <> "" Then
ForwardDateEnabled = True
ForwardDateCaption = ForwardDateDisconnection & " [" & vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), ForwardDateCol) & "]"
ReverseEnables = True
ReverseCaption = ReverseDisconnection & " [" & vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), ForwardDateCol) & "]"
End If
Else
ChangePackageEnabled = True
ChangePackageCaption = ChangePackage & " [" & vsfUUM.TextMatrix(vsfUUM.SelectedRow(0), ChangePackageCol) & "]"
End If
AppendMenu hMenu, MF_STRING, ByVal 21, ChangePackageCaption
If Not ChangePackageEnabled Then
EnableMenuItem hMenu, ByVal 21, MF_BYCOMMAND Or MF_GRAYED
End If
AppendMenu hMenu, MF_SEPARATOR, ByVal 22, "-"
AppendMenu hMenu, MF_STRING, ByVal 23, mnuNew.Caption
If Not NewServiceEnabled Then
EnableMenuItem hMenu, ByVal 23, MF_BYCOMMAND Or MF_GRAYED
End If
AppendMenu hMenu, MF_STRING, ByVal 24, mnuConnection.Caption
If Not InitialConnectionEnabled Then
EnableMenuItem hMenu, ByVal 24, MF_BYCOMMAND Or MF_GRAYED
End If
AppendMenu hMenu, MF_SEPARATOR, ByVal 25, "-"
AppendMenu hMenu, MF_STRING, ByVal 26, BackDateCaption
If Not BackDateEnabled Then
EnableMenuItem hMenu, ByVal 26, MF_BYCOMMAND Or MF_GRAYED
End If
AppendMenu hMenu, MF_STRING, ByVal 27, ForwardDateCaption
If Not ForwardDateEnabled Then
EnableMenuItem hMenu, ByVal 27, MF_BYCOMMAND Or MF_GRAYED
End If
AppendMenu hMenu, MF_STRING, ByVal 28, ReverseCaption
If Not ReverseEnables Then
EnableMenuItem hMenu, ByVal 28, MF_BYCOMMAND Or MF_GRAYED
End If
'get current pointer's x, y
GetCursorPos pt
iClick = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD, pt.x, pt.y, 0, Me.hwnd, ByVal 0&)
' Destroy the menu
DestroyMenu hMenu
If iClick = 21 Then
mnuPackage_Click
ElseIf iClick = 23 Then
mnuNew_Click
ElseIf iClick = 24 Then
mnuConnection_Click
ElseIf iClick = 26 Then
mnuBack_Click
ElseIf iClick = 27 Then
mnuForward_Click
ElseIf iClick = 28 Then
mnuReverse_Click
End If
End Sub
补充：VB , API
