-
vb教程之将我自已的命令加入窗体的控制菜单栏
建一个Project,包含一个Form(Frmmain)和一个Module(MSysMenu)
Frmmain:
Option Explicit
Private Sub Form_Load()
Dim hSysMenu As Long
'Get Handle Of System Menu
hSysMenu = GetSystemMenu(hwnd, 0&)
'Append separator and menu item with ID IDM_ABOUT
Call AppendMenu(hSysMenu, MF_SEPARATOR, 0&, 0&)
Call AppendMenu(hSysMenu, MF_STRING, IDM_ABOUT, "About...")
Call AppendMenu(hSysMenu, MF_STRING, IDM_EXIT, "Exit")
Show
' Install system menu window procedure
procOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SysMenuProc)
End Sub
MSysMenu:
Option Explicit
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
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
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const GWL_WNDPROC = (-4)
Public Const WM_SYSCOMMAND = &H112
Public procOld As Long
'User's menu
Public Const IDM_ABOUT = &H2000
Public Const IDM_EXIT = &H2001
Public Function SysMenuProc(ByVal hwnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Ignore everything but system commands
If iMsg = WM_SYSCOMMAND Then
' Check for one special menu item
Select Case wParam
Case IDM_ABOUT
MsgBox "Hi"
Exit Function
Case IDM_EXIT
Unload FrmMain
Exit Function
End Select
End If
' Let old window procedure handle other messages
SysMenuProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
End Function
Frmmain:
Option Explicit
Private Sub Form_Load()
Dim hSysMenu As Long
'Get Handle Of System Menu
hSysMenu = GetSystemMenu(hwnd, 0&)
'Append separator and menu item with ID IDM_ABOUT
Call AppendMenu(hSysMenu, MF_SEPARATOR, 0&, 0&)
Call AppendMenu(hSysMenu, MF_STRING, IDM_ABOUT, "About...")
Call AppendMenu(hSysMenu, MF_STRING, IDM_EXIT, "Exit")
Show
' Install system menu window procedure
procOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SysMenuProc)
End Sub
MSysMenu:
Option Explicit
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
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
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const GWL_WNDPROC = (-4)
Public Const WM_SYSCOMMAND = &H112
Public procOld As Long
'User's menu
Public Const IDM_ABOUT = &H2000
Public Const IDM_EXIT = &H2001
Public Function SysMenuProc(ByVal hwnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Ignore everything but system commands
If iMsg = WM_SYSCOMMAND Then
' Check for one special menu item
Select Case wParam
Case IDM_ABOUT
MsgBox "Hi"
Exit Function
Case IDM_EXIT
Unload FrmMain
Exit Function
End Select
End If
' Let old window procedure handle other messages
SysMenuProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
End Function
最新更新
求1000阶乘的结果末尾有多少个0
详解MyBatis延迟加载是如何实现的
IDEA 控制台中文乱码4种解决方案
SpringBoot中版本兼容性处理的实现示例
Spring的IOC解决程序耦合的实现
详解Spring多数据源如何切换
Java报错:UnsupportedOperationException in Col
使用Spring Batch实现批处理任务的详细教程
java中怎么将多个音频文件拼接合成一个
SpringBoot整合ES多个精确值查询 terms功能实
数据库审计与智能监控:从日志分析到异
SQL Server 中的数据类型隐式转换问题
SQL Server中T-SQL 数据类型转换详解
sqlserver 数据类型转换小实验
SQL Server数据类型转换方法
SQL Server 2017无法连接到服务器的问题解决
SQLServer地址搜索性能优化
Sql Server查询性能优化之不可小觑的书签查
SQL Server数据库的高性能优化经验总结
SQL SERVER性能优化综述(很好的总结,不要错
uniapp/H5 获取手机桌面壁纸 (静态壁纸)
[前端] DNS解析与优化
为什么在js中需要添加addEventListener()?
JS模块化系统
js通过Object.defineProperty() 定义和控制对象
这是目前我见过最好的跨域解决方案!
减少回流与重绘
减少回流与重绘
如何使用KrpanoToolJS在浏览器切图
performance.now() 与 Date.now() 对比