+ -
当前位置:首页 → 问答吧 → 谁会用AppendMenu这个API函数

谁会用AppendMenu这个API函数

时间:2011-12-08

来源:互联网

谁会用AppendMenu这个API函数,说的详细点,我想在指定的菜单条目下添加一菜单项,并把新菜单项加入代码,应该怎样实现?应该用到那些API函数呢,热心网友帮忙说一下,先谢谢了

作者: a58499   发布时间: 2011-12-08

VB code

'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


作者: Veron_04   发布时间: 2011-12-08