将About加入窗口的系统菜单
2002-06-05 10:29
405 查看
如果能把关于软件的一些信息(About Me)加入窗口的系统菜单是不是很酷啊!
其实这是个很简单的操作,Let's go!
1.添加一个模块(SubClass)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'有关系统菜单的API
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
'有关窗口的消息处理的API
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private 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
Const GWL_WNDPROC = (-4&)
Const WM_SYSCOMMAND = &H112
Const WM_DESTROY = &H2
Dim PrevWndProc&
Public Sub Init(hWnd As Long)
PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubWndProc)
End Sub
Public Sub Terminate(hWnd As Long)
Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)
End Sub
Private Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) _
As Long
If Msg = WM_DESTROY Then Terminate (Form1.hWnd)
If Msg = WM_SYSCOMMAND Then
If wParam = 2002 Then
MsgBox "我是40Star", vbInformation, "hia..hia..."
End If
End If
SubWndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)
End Function
2.在窗口的load事件中加入
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
InsertMenu GetSystemMenu(Me.hWnd, False), 0, MF_BYPOSITION Or MF_SEPARATOR, 2001, "" '加入一条分割线
InsertMenu GetSystemMenu(Me.hWnd, False), 0, MF_BYPOSITION Or MF_STRING, 2002, "About Me(&A)" '加入About me菜单在系统菜单中
Call Init(Me.hWnd)
End Sub
3.在窗口的Unload事件中加入
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Unload(Cancel As Integer)
Call Terminate(Me.hWnd)
End Sub
OK啦!运行一下吧,是不是很好玩 :)
在Win2000 + Vb6中调试通过
Good Luck
其实这是个很简单的操作,Let's go!
1.添加一个模块(SubClass)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'有关系统菜单的API
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
'有关窗口的消息处理的API
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private 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
Const GWL_WNDPROC = (-4&)
Const WM_SYSCOMMAND = &H112
Const WM_DESTROY = &H2
Dim PrevWndProc&
Public Sub Init(hWnd As Long)
PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubWndProc)
End Sub
Public Sub Terminate(hWnd As Long)
Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)
End Sub
Private Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) _
As Long
If Msg = WM_DESTROY Then Terminate (Form1.hWnd)
If Msg = WM_SYSCOMMAND Then
If wParam = 2002 Then
MsgBox "我是40Star", vbInformation, "hia..hia..."
End If
End If
SubWndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)
End Function
2.在窗口的load事件中加入
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
InsertMenu GetSystemMenu(Me.hWnd, False), 0, MF_BYPOSITION Or MF_SEPARATOR, 2001, "" '加入一条分割线
InsertMenu GetSystemMenu(Me.hWnd, False), 0, MF_BYPOSITION Or MF_STRING, 2002, "About Me(&A)" '加入About me菜单在系统菜单中
Call Init(Me.hWnd)
End Sub
3.在窗口的Unload事件中加入
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Unload(Cancel As Integer)
Call Terminate(Me.hWnd)
End Sub
OK啦!运行一下吧,是不是很好玩 :)
在Win2000 + Vb6中调试通过
Good Luck
相关文章推荐
- 千年零一虫
- VC与Delphi之间动态链接库互相调用
- 用Ole Automation实现Delphi和AutoCad之间的数据交换
- IP地址的隐藏(delphi实现 )
- 解析IP地址为主机域名
- 将某一主机域名解析为IP地址
- 用VB和MTS开发多层数据库应用系统
- 使用C#开发COM+组件
- DOM心得
- 用Socket发送电子邮件
- VB计算农历的算法
- 用MCI命令做一个播放器
- 前后分离模型之封装 Api 调用 推荐
- 挨踢部落直播课堂第七期:如何使用React构建同构(isomorphic)应用
- Netscaler数据索引String Map与Pattern Set的区别
- 关于LoadRunner压测过程中出现的error26601的解释