设置系统菜单项的复选标记

fangyds 2003-09-21 07:51:16

在Foobar 2000的系统菜单中有一个PAUSE菜单项，单击后会打上复选标记（√）再单击又取消，这在普通的菜单通过menuname.checked就可以实现。而我正好也想使用这个功能（因为程序没有菜单，但想实现一些功能，又不想影响界面），在CSDN问几次也没人能答上来，只好自己想了个笨方法，虽然是个笨办法，但总比没有好啊(其中添加菜单项到系统菜单是引用了别人的方法，我只是把追加改成插入而已)。
以下是我程序中的一段代码，相信一看就能懂的。本人技业不精，代码也没有作什么优化，有什么问题的话还请各位不吝指出，也希望DX们能有更好的代码。

'***************以下代码在模块中*******************
'**********************操作系统菜单用到的API函数、常数、结构开始**********************
Public ProcOld As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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
'追加菜单项
Public 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
'获取系统菜单的句柄
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
'插入菜单项
Public Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
'修改菜单属性
Public Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
'常数
Public Const WM_SYSCOMMAND = &H112 '单击控制框产生此消息
Public Const MF_SEPARATOR = &H800& '为菜单加一条分隔线
Public Const MF_STRING = &H0& '在菜单中加一个字符串
Public Const MF_BYPOSITION = &H400& '按位置
Public Const MF_ENABLED = &H0&
Public Const MF_CHECKED = &H8& '已复选
Public Const MF_UNCHECKED = &H0& '未复选
Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const GWL_WNDPROC = (-4)
Public Const IDM_ALWAYSONTOP As Long = 1012 '系统“总在最前”菜单（自定义）
Public Const IDM_REFRESH As Long = 1013 '系统“刷新”菜单（自定义）

'菜单项信息的结构
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
'**********************操作系统菜单用到的API函数、常数、结构结束**********************

'**********************窗口总在最前用到的API函数和常数开始**********************
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE
'**********************窗口总在最前用到的API函数和常数结束**********************

Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg '选择传递进来的消息
Case WM_SYSCOMMAND '单击控制框
Select Case wParam '选择单击了哪个菜单
Case IDM_ALWAYSONTOP '“总在最前”菜单
Dim lhSysMenu As Long '存放系统菜单的句柄
Static blnAlwaysOnTop As Boolean '保存“总在最前”的状态的变量
lhSysMenu = GetSystemMenu(frmMusic.hwnd, 0&) '获取系统菜单句柄
blnAlwaysOnTop = Not blnAlwaysOnTop '改变“总在最前”变量的状态
Call AlwaysOnTop(frmMusic.hwnd, blnAlwaysOnTop) '设置或取消窗口总在最前
If blnAlwaysOnTop = True Then
'设置“总在最前”菜单的复选标记
Call ModifyMenu(lhSysMenu, 1, MF_CHECKED Or MF_BYPOSITION Or MF_STRING, IDM_ALWAYSONTOP, "总在最前(&T)")
Else
'取消“总在最前”菜单的复选标记
Call ModifyMenu(lhSysMenu, 1, MF_UNCHECKED Or MF_BYPOSITION Or MF_STRING, IDM_ALWAYSONTOP, "总在最前(&T)")
End If
Exit Function
Case IDM_REFRESH '“刷新”菜单
Call frmMusic.RefreshData '刷新数据内容(此函数为自定义，在此略)
Exit Function
End Select
End Select
WindowProc = CallWindowProc(ProcOld, hwnd, iMsg, wParam, lParam)
End Function

'窗口总在最前
Public Sub AlwaysOnTop(lnghwnd As Long, blnEnabled As Boolean)
If blnEnabled = True Then
SetWindowPos lnghwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
Else
SetWindowPos lnghwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End If
End Sub

'**************以下代码在窗体中***************
'添加菜单项到系统菜单
Public Sub SysMenu()
On Error Resume Next

Dim lhSysMenu As Long
Dim lRet As Long
lhSysMenu = GetSystemMenu(Me.hwnd, 0&)

Dim miiInfo As MENUITEMINFO
'分隔线
With miiInfo
.cbSize = Len(miiInfo)
.fMask = MIIM_ID Or MIIM_TYPE
.fType = MF_SEPARATOR
.wID = 1
End With
lRet = InsertMenuItem(lhSysMenu, 0, MF_BYPOSITION, miiInfo)
'总在最前
With miiInfo
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MF_STRING
.fState = MF_ENABLED
.wID = IDM_ALWAYSONTOP
.dwTypeData = "总在最前(&T)"
.cch = Len(.dwTypeData)
End With
lRet = InsertMenuItem(lhSysMenu, 0, MF_BYPOSITION, miiInfo)
'刷新
With miiInfo
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MF_STRING
.fState = MF_ENABLED
.wID = IDM_REFRESH
.dwTypeData = "刷新(&R)"
.cch = Len(.dwTypeData)
End With
lRet = InsertMenuItem(lhSysMenu, 0, MF_BYPOSITION, miiInfo)
End If
Me.Show
ProcOld = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Load()
Call SysMenu(moInsert) '添加菜单到系统菜单
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, ProcOld)
End Sub

...全文