在窗体系统菜单中加入自己的内容

发表于:2007-07-14来源:作者:点击数: 标签:
在窗体系统菜单中加入自己的内容,使用subclass,占用资源。 Option Explicit Declare Function AppendMenu Lib user32 Alias _ AppendMenuA (ByVal hMenu As Long, ByVal wFlags _ As Long, ByVal wIDNewItem As Long, ByVal _ lpNewItem As String) As Lon
在窗体系统菜单中加入自己的内容,使用subclass,占用资源。  
Option Explicit

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

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

Public Const WM_SYSCOMMAND = &H112
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const IDM_ABOUT As Long = 1010
Public lProcOld As Long

Public Function SysMenuHandler(ByVal hWnd _
As Long, ByVal iMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long
If iMsg = WM_SYSCOMMAND Then
If wParam = IDM_ABOUT Then
MsgBox "歪歪的VB小技巧第22天的技巧", vbInformation, "歪歪的VB技巧"
Exit Function
End If
End If
SysMenuHandler = CallWindowProc(lProcOld, _
hWnd, iMsg, wParam, lParam)
End Function

Public Function SubClass(FormName As Form)
Dim lhSysMenu As Long, lRet As Long

lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)
lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, vbNullString)
lRet = AppendMenu(lhSysMenu, MF_STRING, IDM_ABOUT, "歪歪的VB技巧")
FormName.Show
lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, AddressOf SysMenuHandler)

End Function

  第四步在form窗口的代码框中加入下面的代码
Option Explicit
Private Sub Form_Load()
Dim d As String
d = SubClass(Form1)  
'这里Form1要换成你窗口自己的名字
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub

原文转自:http://www.ltesting.net