谁会用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
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读:74
-
如何安装mysql8.0
阅读:31
-
Word快速设置标题样式步骤详解
阅读:28
-
20+道必知必会的Vue面试题(附答案解析)
阅读:37
-
HTML如何制作表单
阅读:22
-
百词斩可以改天数吗?当然可以,4个步骤轻松修改天数!
阅读:31
-
ET文件格式和XLS格式文件之间如何转化?
阅读:24
-
react和vue的区别及优缺点是什么
阅读:121
-
支付宝人脸识别如何关闭?
阅读:21
-
腾讯微云怎么修改照片或视频备份路径?
阅读:28