Private Sub Form_Unload(Cancel As Integer) Cancel = True End Sub 或 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Cancel = True End Sub
Private Sub Form_Unload(Cancel As Integer) Cancel = True End Sub 或 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Cancel = True End Sub
Private Sub Form_Unload(Cancel As Integer) 'Cancel 用来确定窗体是否从屏幕删除。如果 cancel 为 0,则窗 '体被删除。将 cancel 设置为任何一个非零的值可防止窗体被删除。 Cancel = 1 End Sub
点关闭不关闭form 可以用灰化关闭按纽的方法Private Const SC_CLOSE As Long = &HF060& Private Const MIIM_STATE As Long = &H1& Private Const MIIM_ID As Long = &H2& Private Const MFS_GRAYED As Long = &H3& Private Const WM_NCACTIVATE As Long = &H86Private 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 TypePrivate Declare Function GetSystemMenu Lib "user32" ( _ ByVal hwnd As Long, ByVal bRevert As Long) As LongPrivate Declare Function GetMenuItemInfo Lib "user32" Alias _ "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _ ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As LongPrivate Declare Function SetMenuItemInfo Lib "user32" Alias _ "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _ ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) 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 Declare Function IsWindow Lib "user32" _ (ByVal hwnd As Long) As Long '*********************************************************************************************'****************************************屏蔽最大化按钮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 LongPrivate Const WS_SYSMENU = &H80000 Private Const WS_MINIMIZEBOX = &H20000 Private Const WS_MAXIMIZEBOX = &H10000Private Const GWL_STYLE = (-16) Set clsCloseButton = New class1 clsCloseButton.EnableCloseButton Me.hWnd, False以下过程我放在了类模块1中 Public Function EnableCloseButton(ByVal hwnd As Long, Enable As Boolean) _ As Integer On Error Resume Next Const xSC_CLOSE As Long = -10 ' Check that the window handle passed is valid
EnableCloseButton = -1 If IsWindow(hwnd) = 0 Then Exit Function
' Retrieve a handle to the window's system menu
Dim hMenu As Long hMenu = GetSystemMenu(hwnd, 0)
' Retrieve the menu item information for the close menu item/button
Dim MII As MENUITEMINFO MII.cbSize = Len(MII) MII.dwTypeData = String(80, 0) MII.cch = Len(MII.dwTypeData) MII.fMask = MIIM_STATE
If Enable Then MII.wID = xSC_CLOSE Else MII.wID = SC_CLOSE End If
EnableCloseButton = -0 If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
' Switch the ID of the menu item so that VB can not undo the action itself
Dim lngMenuID As Long lngMenuID = MII.wID
If Enable Then MII.wID = SC_CLOSE Else MII.wID = xSC_CLOSE End If
MII.fMask = MIIM_ID EnableCloseButton = -2 If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Exit Function
' Set the enabled / disabled state of the menu item
If Enable Then MII.fState = (MII.fState Or MFS_GRAYED) MII.fState = MII.fState - MFS_GRAYED Else MII.fState = (MII.fState Or MFS_GRAYED) End If
MII.fMask = MIIM_STATE EnableCloseButton = -3 If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
' Activate the non-client area of the window to update the titlebar, and ' draw the close button in its new state.
要Disable Form "X" -->Close的功能(便暗灰色),事实上便是从Form左上方的SystemMenu将关闭的MenuItem去除掉便可以了,去除后,又该如何,那便是在将关闭(Close)的MenuItem加回去 但这里有个小问题,加回去之后"X"仍是暗灰色,要等到我们做了某些固定的动作之后(如TittleBar上Click一下,或选一下SystemMenu等), 我不知道让TittleBar上的这些东西Refresh要送什么消息,所以现在我暂且Send一个在TittleBar上按下Mouse左键的消息给窗体,令"X"能出现的Enable颜色 在窗体上放置一个Command Button,输入以下代码,运行,点击一下Command Button 就可使"X" Enable. Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long Private Declare Function GetMenuString Lib "User32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Const WM_NCLBUTTONDBLCLK = &HA3 Const WM_NCLBUTTONDOWN = &HA1 Const HTCAPTION = 2 Const MF_STRING = &H0& Const MF_BYCOMMAND = &H0& Const SC_CLOSE = &HF060 Private hMenu As Long Private CloseStr As String '纪录Close MenuItem的字符串 Private Sub Command1_Click() '将"关闭"的那个MenuItem重新加入 Call AppendMenu(hMenu, MF_STRING, SC_CLOSE, CloseStr) '令"X"出现Enable的颜色 Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End Sub Private Sub Form_Load() hMenu = GetSystemMenu(Me.hwnd, 0) CloseStr = String(255, 0) 'SC_CLOSE即是"关闭"的MenuItem ID Call GetMenuString(hMenu, SC_CLOSE, CloseStr, 256, MF_BYCOMMAND) CloseStr = Left(CloseStr, InStr(1, CloseStr, Chr(0)) - 1) Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND) End Sub
其实只要在form的QueryUnload事件中设置cancel=true就可以了。 以下是事例: Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer) If MsgBox("请确认您是否真的退出?", vbQuestion + vbYesNo) <> 7 Then End Else Cancel = True End If End Sub
如何让窗体右上角的X失效? 在VB中,每个窗体都有两个卸载事件,不同的是,QueryUnload事件不仅允许用户 取消进程,并且告诉程序做些什么来开始卸载工作。为使窗体右上角的X失效,并 下面的代码放在该事件中就行了。Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Cancel = -1End Sub
Cancel = True
End Sub
或
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = True
End Sub
Cancel = True
End Sub
或
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = True
End Sub
'Cancel 用来确定窗体是否从屏幕删除。如果 cancel 为 0,则窗
'体被删除。将 cancel 设置为任何一个非零的值可防止窗体被删除。
Cancel = 1
End Sub
可以用灰化关闭按纽的方法Private Const SC_CLOSE As Long = &HF060&
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86Private 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 TypePrivate Declare Function GetSystemMenu Lib "user32" ( _
ByVal hwnd As Long, ByVal bRevert As Long) As LongPrivate Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As LongPrivate Declare Function SetMenuItemInfo Lib "user32" Alias _
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) 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 Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
'*********************************************************************************************'****************************************屏蔽最大化按钮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 LongPrivate Const WS_SYSMENU = &H80000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000Private Const GWL_STYLE = (-16)
Set clsCloseButton = New class1
clsCloseButton.EnableCloseButton Me.hWnd, False以下过程我放在了类模块1中
Public Function EnableCloseButton(ByVal hwnd As Long, Enable As Boolean) _
As Integer
On Error Resume Next
Const xSC_CLOSE As Long = -10 ' Check that the window handle passed is valid
EnableCloseButton = -1
If IsWindow(hwnd) = 0 Then Exit Function
' Retrieve a handle to the window's system menu
Dim hMenu As Long
hMenu = GetSystemMenu(hwnd, 0)
' Retrieve the menu item information for the close menu item/button
Dim MII As MENUITEMINFO
MII.cbSize = Len(MII)
MII.dwTypeData = String(80, 0)
MII.cch = Len(MII.dwTypeData)
MII.fMask = MIIM_STATE
If Enable Then
MII.wID = xSC_CLOSE
Else
MII.wID = SC_CLOSE
End If
EnableCloseButton = -0
If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
' Switch the ID of the menu item so that VB can not undo the action itself
Dim lngMenuID As Long
lngMenuID = MII.wID
If Enable Then
MII.wID = SC_CLOSE
Else
MII.wID = xSC_CLOSE
End If
MII.fMask = MIIM_ID
EnableCloseButton = -2
If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Exit Function
' Set the enabled / disabled state of the menu item
If Enable Then
MII.fState = (MII.fState Or MFS_GRAYED)
MII.fState = MII.fState - MFS_GRAYED
Else
MII.fState = (MII.fState Or MFS_GRAYED)
End If
MII.fMask = MIIM_STATE
EnableCloseButton = -3
If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
' Activate the non-client area of the window to update the titlebar, and
' draw the close button in its new state.
SendMessage hwnd, WM_NCACTIVATE, True, 0
EnableCloseButton = 0
End Function
要Disable Form "X" -->Close的功能(便暗灰色),事实上便是从Form左上方的SystemMenu将关闭的MenuItem去除掉便可以了,去除后,又该如何,那便是在将关闭(Close)的MenuItem加回去 但这里有个小问题,加回去之后"X"仍是暗灰色,要等到我们做了某些固定的动作之后(如TittleBar上Click一下,或选一下SystemMenu等), 我不知道让TittleBar上的这些东西Refresh要送什么消息,所以现在我暂且Send一个在TittleBar上按下Mouse左键的消息给窗体,令"X"能出现的Enable颜色
在窗体上放置一个Command Button,输入以下代码,运行,点击一下Command Button 就可使"X" Enable.
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetMenuString Lib "User32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_NCLBUTTONDBLCLK = &HA3
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Const MF_STRING = &H0&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060
Private hMenu As Long
Private CloseStr As String '纪录Close MenuItem的字符串
Private Sub Command1_Click()
'将"关闭"的那个MenuItem重新加入
Call AppendMenu(hMenu, MF_STRING, SC_CLOSE, CloseStr)
'令"X"出现Enable的颜色
Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
Private Sub Form_Load()
hMenu = GetSystemMenu(Me.hwnd, 0)
CloseStr = String(255, 0)
'SC_CLOSE即是"关闭"的MenuItem ID
Call GetMenuString(hMenu, SC_CLOSE, CloseStr, 256, MF_BYCOMMAND)
CloseStr = Left(CloseStr, InStr(1, CloseStr, Chr(0)) - 1)
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
End Sub
以下是事例:
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If MsgBox("请确认您是否真的退出?", vbQuestion + vbYesNo) <> 7 Then
End
Else
Cancel = True
End If
End Sub
在VB中,每个窗体都有两个卸载事件,不同的是,QueryUnload事件不仅允许用户
取消进程,并且告诉程序做些什么来开始卸载工作。为使窗体右上角的X失效,并
下面的代码放在该事件中就行了。Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = -1End Sub