如何使无边框窗体的系统菜单中的关闭有效?(有没有高手?)

oldcathb 2005-09-20 03:06:37

大家有没有使用过无边框窗体的系统菜单?系统菜单本身在窗体设置成无边框窗体后不会出现,调用API后调出系统菜单,但关闭按钮不起作用,请各位高手如何才能使关闭按钮起作用呢?
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Sub Form_Load()
Dim lStyle As Long '在任务栏上显示右键菜单
Dim l As Long
lStyle = WS_SYSMENU
'使“大小”有效
'lStyle = lStyle Or WS_SIZEBOX
'使“最大化”有效
' lStyle = lStyle Or WS_MAXIMIZEBOX
'使“最小化”有效
lStyle = lStyle Or WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, lStyle
End Sub

...全文

295 5 打赏收藏转发到动态举报

写回复

用AI写文章

5 条回复

切换为时间正序

请发表友善的回复…

发表回复

jhtzz 2005-10-16

打赏
举报

在模块中做
Public Function SubClass1_WndMessage(ByVal HWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
If Msg <> WM_SYSCOMMAND Then
SubClass1_WndMessage = CallWindowProc(OldWindowProc, HWnd, Msg, wp, lp)
Exit Function
End If
Select Case wp
Case 61536 '可以拦住关闭东东
Call PostMessage(HWnd, WM_CLOSE, 0&, 0&)
Case Else
SubClass1_WndMessage = CallWindowProc(OldWindowProc, HWnd, Msg, wp, lp)
Exit Function
End Select
SubClass1_WndMessage = True
End Function

在窗体的load里加入
OldWindowProc = GetWindowLong(Me.HWnd, GWL_WNDPROC)
Call SetWindowLong(Me.HWnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
在窗体的unload 里面加入
If OldWindowProc <> 0 Then
Call SetWindowLong(Me.HWnd, GWL_WNDPROC, OldWindowProc)
End If
其它的API相信你找得到吧,差常量就去baidu里面找,差API就去baidu里面找,决定OK

northwolves 2005-10-16

打赏
举报

与 http://community.csdn.net/Expert/topic/4328/4328695.xml?temp=.9624292差不多,

个人认为无标题栏窗口,使用菜单不要使用BorderStyle=0,可以裁剪之,如:

Option Explicit
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Sub Form_Click() '调用系统菜单
SendKeys "%{ }"
End Sub

Private Sub Form_Load()
Me.WindowState = 0
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2, 8000, 5000 '居中及设置窗体大小
Dim capheight As Long, area As Long
Me.ScaleMode = 2
Me.ForeColor = vbRed
Me.Line (1, 0)-(Me.Width, 0) '紧贴标题栏画线做标记
capheight = GetSystemMetrics(33) + GetSystemMetrics(4) ' 边框宽度+标题栏高度
area = CreateRectRgn(0, capheight, Me.Width, Me.Height) '画无标题栏的矩形框
area = SetWindowRgn(Me.hWnd, area, True) '裁剪标题栏
End Sub