level 1
如果你不想只能在标题栏上单击鼠标右键才能弹出系统菜单。你可以使用一下方法。这个方法在自绘标题栏方面很实用。新建模块,代码如下:Option ExplicitPrivate Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal Hwnd As Long, lprc As RECT) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Declare Function GetSystemMenu Lib "user32" (ByVal Hwnd As Long, ByVal bRevert As Long) As LongPrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Type POINTAPI X As Long Y As LongEnd TypePublic Sub ShowSystemMenu(Hwnd As Long)On Error Resume Next Dim r As RECT Dim p As POINTAPI GetCursorPos p TrackPopupMenu GetSystemMenu(Hwnd, 0&), 0, p.X, p.Y, 0, Hwnd, rEnd Sub窗口代码如下:Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 Then Call ShowSystemMenu(Me.Hwnd)End Sub
2008年06月26日 17点06分
1
level 1
上面的方法调出得系统菜单只能看不能用。用下面这个方法可以更正这个问题。不过要使用到钩子:本例子只需要一个窗口和一个模块。无需任何控件:模块:Option ExplicitPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic 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 LongPrivate Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As LongPublic ProcOld As LongPublic Const TPM_LEFTALIGN = &H0&Public Const WM_SYSCOMMAND = &H112Public Const MF_SEPARATOR = &H800&Public Const MF_STRING = &H0&Public Const GWL_WNDPROC = (-4)Public Const IDM_ABOUT As Long = 1010Public Const WM_COMMAND = &H111Public lRet As LongPrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Type POINTAPI X As Long Y As LongEnd TypePublic Sub ShowSystemMenu(hwnd As Long)On Error Resume Next Dim r As RECT Dim p As POINTAPI GetCursorPos p TrackPopupMenu GetSystemMenu(hwnd, 0&), 0, p.X, p.Y, 0, hwnd, rEnd SubPublic 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 If wParam = IDM_ABOUT Then MsgBox "VB Web Append to System Menu Example", vbInformation, "About"Exit Function End If Case WM_COMMAND CallWindowProc ProcOld, hwnd, WM_SYSCOMMAND, wParam, lParam WindowProc = 0 Exit Function End Select WindowProc = CallWindowProc(ProcOld, hwnd, iMsg, wParam, lParam)End Function窗口:Option ExplicitPrivate Sub Form_Load()ProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 Then Call ShowSystemMenu(Me.hwnd)End SubPrivate Sub Form_Unload(Cancel As Integer)SetWindowLong hwnd, GWL_WNDPROC, ProcOldEnd Sub
2008年06月26日 17点06分
2
level 1
发现个问题,如果窗口上有按钮,就不能用了。Private Sub Command1_Click()Print "aa"End Sub就显示不出来了。
2008年06月27日 01点06分
4
level 1
如果是没边框的窗口,想要在任务栏也用菜单怎么弄?谁会?
2008年07月09日 06点07分
8
level 7
'系统菜单不用子类化就行了阿,菜单+菜单功能Private Type POINTAPI x As Long y As LongEnd TypePrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Const HTCAPTION = 2Private Const WM_NCRBUTTONDOWN = &HA4Private Const WM_SYSCOMMAND = &H112Private Const TPM_LEFTBUTTON = &H0&Private Const TPM_RETURNCMD = &H100&Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As LongPrivate Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 2 Then Dim vPoint As POINTAPI Dim vRect As RECT Call GetCursorPos(vPoint) Call SendMessage(Me.hwnd, WM_SYSCOMMAND, TrackPopupMenu(GetSystemMenu(Me.hwnd, 0), _ TPM_RETURNCMD Or TPM_LEFTBUTTON, vPoint.x, vPoint.y, 0, Me.hwnd, vRect), 0) End IfEnd Sub
2008年07月10日 08点07分
9
level 0
9楼 Ultraman_King 的方法是最好的。代码简单。
2008年07月14日 00点07分
15
level 1
To 8F 想要没标题栏又要有系统菜单。看看这个:Option ExplicitPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Const GWL_STYLE = (-16)Private Const WS_CAPTION = &HC00000Private Const WS_SYSMENU = &H80000Private Const WS_THICKFRAME = &H40000Private Sub Form_Initialize() Dim lStyle As Long lStyle = GetWindowLong(Me.hwnd, GWL_STYLE) lStyle = lStyle And Not WS_CAPTION lStyle = lStyle And Not WS_THICKFRAME lStyle = lStyle Or WS_SYSMENU SetWindowLong Me.hwnd, GWL_STYLE, lStyle Me.RefreshEnd Sub
2008年07月14日 00点07分
16
level 1
无标题栏 + 系统菜单:使用了8楼老师的代码,我那段代码太繁杂:Option ExplicitPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Type POINTAPI X As Long Y As LongEnd TypePrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Const HTCAPTION = 2Private Const WM_NCRBUTTONDOWN = &HA4Private Const WM_SYSCOMMAND = &H112Private Const TPM_LEFTBUTTON = &H0&Private Const TPM_RETURNCMD = &H100&Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As LongPrivate Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const GWL_STYLE = (-16)Private Const WS_CAPTION = &HC00000Private Const WS_SYSMENU = &H80000Private Const WS_THICKFRAME = &H40000Private Sub Form_Initialize() Dim lStyle As Long lStyle = GetWindowLong(Me.hwnd, GWL_STYLE) lStyle = lStyle And Not WS_CAPTION lStyle = lStyle And Not WS_THICKFRAME lStyle = lStyle Or WS_SYSMENU SetWindowLong Me.hwnd, GWL_STYLE, lStyle Me.RefreshEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 Then Dim vPoint As POINTAPI Dim vRect As RECT Call GetCursorPos(vPoint) Call SendMessage(Me.hwnd, WM_SYSCOMMAND, TrackPopupMenu(GetSystemMenu(Me.hwnd, 0), _ TPM_RETURNCMD Or TPM_LEFTBUTTON, vPoint.X, vPoint.Y, 0, Me.hwnd, vRect), 0) End IfEnd Sub
2008年07月14日 00点07分
17
level 0
var r:TRect; mnu:HMENU; p:TPoint;begin mnu:=GetSystemMenu(Self.Handle,False); GetCursorPos(p); GetWindowRect(mnu,r); TrackPopupMenu(mnu,0,p.X,p.Y,0,Self.Handle,@r);end;这样可以了,有需要的可以转化为VB的,很简单
2008年07月15日 06点07分
18
level 0
Java.C#高手交流群 QQ群:65977789
2008年07月15日 13点07分
19
level 7
新手用的笨办法:
建无边框窗体,用image构建假窗体,然后在代表标题栏、最小化按钮、模式切换按钮的image里添加移动窗体、右击、最小化、关闭等代码
2009年07月15日 07点07分
21
level 0
为什么还有人执迷不误,右键标题栏系统菜单就是左键点窗口左上角的图标出来的菜单!
这是微软以前为了拉拢苹果系统(卖劲脱O身)的用户保留的,经过这么多年的培养用户使用右上角的三个窗口控制按钮,基本没人使用这个标题栏系统菜单(大部分人都不知道了)!微软window 7已经局部取消这个菜单了!!!
2009年07月16日 00点07分
22