回 帖 发 新 帖 刷新版面

主题:如何在窗体的标题栏单击右键弹出快捷菜单?

我是一个初学者,甚至连实现这个是很容易还是很复杂都不知道。

if 容易 then
   望DX们指点指点
else
   只要告诉我比较复杂,我暂时不学它
end if

先谢了!

回复列表 (共6个回复)

沙发

默认情况下右击窗体标题栏会弹出系统菜单,你可以通过API函数来屏蔽某些项。
如果你说的是右击窗体标题栏弹出自己定义的快捷菜单,那么也许能通过API函数来实现,不过我没试过,无法告诉你难与易。

板凳

不难也不易。

3 楼

写出来怕你又看不懂。

4 楼

经过试验,以下代码可以达到你的要求

模块的代码:
----------
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert 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 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
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 String) As Long

Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const GWL_WNDPROC = (-4)
Public Const WM_SYSCOMMAND = &H112
Public Const MF_BYPOSITION = &H400&

Public OldWinProc As Long

Public Function NewWindowProc(ByVal inHWND As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_SYSCOMMAND Then
  Select Case wParam
    Case 0: MsgBox "新建"
    Case 1: MsgBox "保存"
    Case 2: MsgBox "打开"
    Case 3: MsgBox "剪切"
    Case 4: MsgBox "复制"
    Case 5: MsgBox "粘贴"
    Case 6: MsgBox "撤消"
    Case 8: MsgBox "添加菜单项"
  End Select
  Exit Function
End If
NewWindowProc = CallWindowProc(OldWinProc, inHWND, Msg, wParam, lParam)
End Function

Form1的代码:
-----------
Private Sub Form_Load()
Dim mSysMenu As Long
mSysMenu = GetSystemMenu(Me.hwnd, False) '取得系统菜单的句柄
ModifyMenu mSysMenu, 0, MF_BYPOSITION, 0, "新建"
ModifyMenu mSysMenu, 1, MF_BYPOSITION, 1, "保存"
ModifyMenu mSysMenu, 2, MF_BYPOSITION, 2, "打开"
ModifyMenu mSysMenu, 3, MF_BYPOSITION, 3, "剪切"
ModifyMenu mSysMenu, 4, MF_BYPOSITION, 4, "复制"
ModifyMenu mSysMenu, 5, MF_BYPOSITION, 5, "粘贴"
ModifyMenu mSysMenu, 6, MF_BYPOSITION, 6, "撤消"
AppendMenu mSysMenu, MF_SEPARATOR, 7, "-" ' 在指定的条目处显示一条分隔线
AppendMenu mSysMenu, MF_STRING, 8, "添加菜单项"
OldWinProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

但是这样一来,没有了系统菜单,窗体右上角的按纽也不起作用,你将无法移动、关闭或最大、最小化
,因此建议保留系统菜单,不要用ModifyMenu更改,而使用AppendMenu函数在原菜单的下面添加新菜单项

5 楼

'----------------------------------------------mod1
Option Explicit

Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert 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 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
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 String) As Long

Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const GWL_WNDPROC = (-4)
Public Const WM_SYSCOMMAND = &H112
Public Const MF_BYPOSITION = &H400&

Public OldWinProc As Long

Public Function NewWindowProc(ByVal inHWND As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_SYSCOMMAND Then
  Select Case wParam
    Case 0: MsgBox "新建"
    Case 1: MsgBox "保存"
    Case 2: MsgBox "打开"
    Case 3: MsgBox "剪切"
    Case 4: MsgBox "复制"
    Case 5: MsgBox "粘贴"
    Case 6: MsgBox "撤消"
    Case 8: MsgBox "添加菜单项"
  End Select
End If
NewWindowProc = CallWindowProc(OldWinProc, inHWND, Msg, wParam, lParam)
End Function


'-----------------------------------------from1
Option Explicit

Private Sub Form_Load()
Dim mSysMenu As Long
mSysMenu = GetSystemMenu(Me.hwnd, False) '取得系统菜单的句柄
AppendMenu mSysMenu, MF_SEPARATOR, 7, "-"  ' 在指定的条目处显示一条分隔线
AppendMenu mSysMenu, MF_BYPOSITION, 0, "新建"
AppendMenu mSysMenu, MF_BYPOSITION, 1, "保存"
AppendMenu mSysMenu, MF_BYPOSITION, 2, "打开"
AppendMenu mSysMenu, MF_BYPOSITION, 3, "剪切"
AppendMenu mSysMenu, MF_BYPOSITION, 4, "复制"
AppendMenu mSysMenu, MF_BYPOSITION, 5, "粘贴"
AppendMenu mSysMenu, MF_BYPOSITION, 6, "撤消"
AppendMenu mSysMenu, MF_SEPARATOR, 7, "-" ' 在指定的条目处显示一条分隔线
AppendMenu mSysMenu, MF_STRING, 8, "添加菜单项"
OldWinProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

'要服务就做好
[url=http://file.pfan.cn/upfile/200804230756849.zip]再加个服务[/url]

6 楼


昨天没上班,没想到有这么多热心人回复,谢谢各位。

对我来说算是比较难的了,因为我目前还只是懂一点皮毛,我是搞硬件的(单片机编程),VB只是想了解一下,工作中不一定用得不上。

看了几天书了,写了两个很简单的程序,以后再遇到什么问题,还望大家不吝赐教。

我来回复

您尚未登录,请登录后再回复。点此登录或注册