Private No_Maximum As BooleanPrivate Sub Command1_Click() No_Maximum = True End SubPrivate Sub Command2_Click() No_Maximum = False End SubPrivate Sub Form_Resize() If Me.WindowState = 2 And No_Maximum Then Me.WindowState = Normal End If End Sub
Private Sub Command1_Click() me.MaxButton=false End SubPrivate Sub Command2_Click() me.MaxButton=true End Sub
窗体Form1模块: Form1上放三个按钮Command1,Command2,Command3。每个按钮按2次,奇数次禁止,偶数次恢复。 Option ExplicitPrivate m_blnClose As Boolean Private m_blnMin As Boolean Private m_blnMax As Boolean Private Sub Command1_Click() m_blnMax = Not m_blnMax EnableMaxButton Form1.hWnd, m_blnMax End SubPrivate Sub Command2_Click() m_blnMin = Not m_blnMin EnableMinButton Form1.hWnd, m_blnMin End SubPrivate Sub Command3_Click() m_blnClose = Not m_blnClose EnableCloseButton Form1.hWnd, m_blnClose End SubPrivate Sub Form_Load() m_blnClose = True m_blnMin = True m_blnMax = True End Sub标准模块Module1.bas: Option ExplicitPrivate Const SC_CLOSE As Long = &HF060& Private Const SC_MAXIMIZE As Long = &HF030& Private Const SC_MINIMIZE As Long = &HF020&Private Const xSC_CLOSE As Long = -10& Private Const xSC_MAXIMIZE As Long = -11& Private Const xSC_MINIMIZE As Long = -12&Private Const GWL_STYLE = (-16) Private Const WS_MAXIMIZEBOX = &H10000 Private Const WS_MINIMIZEBOX = &H20000Private Const hWnd_NOTOPMOST = -2 Private Const SWP_NOZORDER = &H4 Private Const SWP_NOSIZE = &H1 Private Const SWP_NOMOVE = &H2 Private Const SWP_FRAMECHANGED = &H20Private 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 Long Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) 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 Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long 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 Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Function EnableCloseButton(ByVal hWnd As Long, Enable As Boolean) As Integer EnableSystemMenuItem hWnd, SC_CLOSE, xSC_CLOSE, Enable, "EnableCloseButton" End Function'******************************************************************************* ' Enable / Disable Minimise Button '-------------------------------------------------------------------------------Public Sub EnableMinButton(ByVal hWnd As Long, Enable As Boolean) ' Enable / Disable System Menu Item EnableSystemMenuItem hWnd, SC_MINIMIZE, xSC_MINIMIZE, Enable, _ "EnableMinButton"
' Enable / Disable TitleBar button
Dim lngFormStyle As Long lngFormStyle = GetWindowLong(hWnd, GWL_STYLE) If Enable Then lngFormStyle = lngFormStyle Or WS_MINIMIZEBOX Else lngFormStyle = lngFormStyle And Not WS_MINIMIZEBOX End If SetWindowLong hWnd, GWL_STYLE, lngFormStyle
' Dirty, slimy, devious hack to ensure that the changes to the ' window's style take immediate effect before the form is shown
SetParent hWnd, GetParent(hWnd) SetWindowPos hWnd, hWnd_NOTOPMOST, 0, 0, 0, 0, _ SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED End Sub'******************************************************************************* ' Enable / Disable Maximise Button '-------------------------------------------------------------------------------Public Sub EnableMaxButton(ByVal hWnd As Long, Enable As Boolean) ' Enable / Disable System Menu Item EnableSystemMenuItem hWnd, SC_MAXIMIZE, xSC_MAXIMIZE, Enable, _ "EnableMaxButton"
' Enable / Disable TitleBar button
Dim lngFormStyle As Long lngFormStyle = GetWindowLong(hWnd, GWL_STYLE) If Enable Then lngFormStyle = lngFormStyle Or WS_MAXIMIZEBOX Else lngFormStyle = lngFormStyle And Not WS_MAXIMIZEBOX End If SetWindowLong hWnd, GWL_STYLE, lngFormStyle
' Dirty, slimy, devious hack to ensure that the changes to the ' window's style take immediate effect before the form is shown
SetParent hWnd, GetParent(hWnd) SetWindowPos hWnd, hWnd_NOTOPMOST, 0, 0, 0, 0, _ SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED End Sub'******************************************************************************* ' '-------------------------------------------------------------------------------Private Sub EnableSystemMenuItem(hWnd As Long, Item As Long, _ Dummy As Long, Enable As Boolean, FuncName As String)
If IsWindow(hWnd) = 0 Then Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _ "modCloseBtn::" & FuncName & "() - Invalid Window Handle" Exit Sub End If
' Retrieve a handle to the window's system menu
Dim hMenu As Long hMenu = GetSystemMenu(hWnd, 0)
' Retrieve the menu item information for the Max 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 = Dummy Else MII.wID = Item End If
If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _ "modCloseBtn::" & FuncName & "() - Menu Item Not Found" Exit Sub End If
' 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 = Item Else MII.wID = Dummy End If
MII.fMask = MIIM_ID If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _ "modCloseBtn::" & FuncName & "() - Error encountered " & _ "changing ID" Exit Sub End If
' Set the enabled / disabled state of the menu item
If Enable Then MII.fState = MII.fState And Not MFS_GRAYED Else MII.fState = MII.fState Or MFS_GRAYED End If
MII.fMask = MIIM_STATE If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _ "modCloseBtn::" & FuncName & "() - Error encountered " & _ "changing state" Exit Sub End If
' Activate the non-client area of the window to update the titlebar, and ' draw the Max button in its new state.
SendMessage hWnd, WM_NCACTIVATE, True, 0
End Sub'******************************************************************************* ' '-------------------------------------------------------------------------------
No_Maximum = True
End SubPrivate Sub Command2_Click()
No_Maximum = False
End SubPrivate Sub Form_Resize()
If Me.WindowState = 2 And No_Maximum Then
Me.WindowState = Normal
End If
End Sub
me.MaxButton=false
End SubPrivate Sub Command2_Click()
me.MaxButton=true
End Sub
Form1上放三个按钮Command1,Command2,Command3。每个按钮按2次,奇数次禁止,偶数次恢复。
Option ExplicitPrivate m_blnClose As Boolean
Private m_blnMin As Boolean
Private m_blnMax As Boolean
Private Sub Command1_Click()
m_blnMax = Not m_blnMax
EnableMaxButton Form1.hWnd, m_blnMax
End SubPrivate Sub Command2_Click()
m_blnMin = Not m_blnMin
EnableMinButton Form1.hWnd, m_blnMin
End SubPrivate Sub Command3_Click()
m_blnClose = Not m_blnClose
EnableCloseButton Form1.hWnd, m_blnClose
End SubPrivate Sub Form_Load()
m_blnClose = True
m_blnMin = True
m_blnMax = True
End Sub标准模块Module1.bas:
Option ExplicitPrivate Const SC_CLOSE As Long = &HF060&
Private Const SC_MAXIMIZE As Long = &HF030&
Private Const SC_MINIMIZE As Long = &HF020&Private Const xSC_CLOSE As Long = -10&
Private Const xSC_MAXIMIZE As Long = -11&
Private Const xSC_MINIMIZE As Long = -12&Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000Private Const hWnd_NOTOPMOST = -2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_FRAMECHANGED = &H20Private 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 Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) 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
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
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 Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Function EnableCloseButton(ByVal hWnd As Long, Enable As Boolean) As Integer EnableSystemMenuItem hWnd, SC_CLOSE, xSC_CLOSE, Enable, "EnableCloseButton"
End Function'*******************************************************************************
' Enable / Disable Minimise Button
'-------------------------------------------------------------------------------Public Sub EnableMinButton(ByVal hWnd As Long, Enable As Boolean) ' Enable / Disable System Menu Item EnableSystemMenuItem hWnd, SC_MINIMIZE, xSC_MINIMIZE, Enable, _
"EnableMinButton"
' Enable / Disable TitleBar button
Dim lngFormStyle As Long
lngFormStyle = GetWindowLong(hWnd, GWL_STYLE)
If Enable Then
lngFormStyle = lngFormStyle Or WS_MINIMIZEBOX
Else
lngFormStyle = lngFormStyle And Not WS_MINIMIZEBOX
End If
SetWindowLong hWnd, GWL_STYLE, lngFormStyle
' Dirty, slimy, devious hack to ensure that the changes to the
' window's style take immediate effect before the form is shown
SetParent hWnd, GetParent(hWnd)
SetWindowPos hWnd, hWnd_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub'*******************************************************************************
' Enable / Disable Maximise Button
'-------------------------------------------------------------------------------Public Sub EnableMaxButton(ByVal hWnd As Long, Enable As Boolean) ' Enable / Disable System Menu Item EnableSystemMenuItem hWnd, SC_MAXIMIZE, xSC_MAXIMIZE, Enable, _
"EnableMaxButton"
' Enable / Disable TitleBar button
Dim lngFormStyle As Long
lngFormStyle = GetWindowLong(hWnd, GWL_STYLE)
If Enable Then
lngFormStyle = lngFormStyle Or WS_MAXIMIZEBOX
Else
lngFormStyle = lngFormStyle And Not WS_MAXIMIZEBOX
End If
SetWindowLong hWnd, GWL_STYLE, lngFormStyle
' Dirty, slimy, devious hack to ensure that the changes to the
' window's style take immediate effect before the form is shown
SetParent hWnd, GetParent(hWnd)
SetWindowPos hWnd, hWnd_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub'*******************************************************************************
'
'-------------------------------------------------------------------------------Private Sub EnableSystemMenuItem(hWnd As Long, Item As Long, _
Dummy As Long, Enable As Boolean, FuncName As String)
If IsWindow(hWnd) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Invalid Window Handle"
Exit Sub
End If
' Retrieve a handle to the window's system menu
Dim hMenu As Long
hMenu = GetSystemMenu(hWnd, 0)
' Retrieve the menu item information for the Max 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 = Dummy
Else
MII.wID = Item
End If
If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Menu Item Not Found"
Exit Sub
End If
' 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 = Item
Else
MII.wID = Dummy
End If
MII.fMask = MIIM_ID
If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Error encountered " & _
"changing ID"
Exit Sub
End If
' Set the enabled / disabled state of the menu item
If Enable Then
MII.fState = MII.fState And Not MFS_GRAYED
Else
MII.fState = MII.fState Or MFS_GRAYED
End If
MII.fMask = MIIM_STATE
If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then
Err.Raise vbObjectError, "modCloseBtn::" & FuncName, _
"modCloseBtn::" & FuncName & "() - Error encountered " & _
"changing state"
Exit Sub
End If
' Activate the non-client area of the window to update the titlebar, and
' draw the Max button in its new state.
SendMessage hWnd, WM_NCACTIVATE, True, 0
End Sub'*******************************************************************************
'
'-------------------------------------------------------------------------------