ماژول
Option Explicit
' Used to get menu information.
Private 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 Type
' Menu information constants.
Private Const MIIM_STATE As Long = &H1
Private Const MIIM_ID As Long = &H2
Private Const MIIM_SUBMENU As Long = &H4
Private Const MIIM_CHECKMARKS As Long = &H8
Private Const MIIM_TYPE As Long = &H10
Private Const MIIM_DATA As Long = &H20
' System menu command values commonly used by VB.
Private Const SC_SIZE = &HF000&
Private Const SC_MOVE = &HF010&
Private Const SC_MINIMIZE = &HF020&
Private Const SC_MAXIMIZE = &HF030&
Private Const SC_CLOSE = &HF060&
Private Const SC_RESTORE = &HF120&
' Enumerated sysmenu items.
Public Enum SysMenuItems
smRestore = SC_RESTORE
smMove = SC_MOVE
smSize = SC_SIZE
smMinimize = SC_MINIMIZE
smMaximize = SC_MAXIMIZE
smClose = SC_CLOSE
End Enum
' Used to select which menu to remove.
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
' Toggles enabled state of menu item.
Private Const MF_ENABLED = &H0&
Private Const MF_GRAYED = &H1&
Private Const MF_DISABLED = &H2&
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As _
Long, ByVal revert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu _
As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As _
Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias _
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal bool As Long, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Function GetMenuItemPosition(frm As Form, _
ByVal MenuItem As SysMenuItems) As Long
Dim hMenu As Long
Dim ID As Long
Dim i As Long
Const HighBit As Long = &H8000&
' Default to returning -1 in case of
' failure, since menu is 0-based.
GetMenuItemPosition = -1
' Retrieve handle to system menu.
hMenu = GetSystemMenu(frm.hWnd, False)
' Loop through system menu, scanning
' for requested standard menu item.
For i = 0 To GetMenuItemCount(hMenu) - 1
ID = GetMenuItemID(hMenu, i)
If ID = MenuItem Then
' Return position of normal
' enabled menu item.
GetMenuItemPosition = i
Exit For
ElseIf ID = (MenuItem And Not HighBit) Then
' This item is disabled.
' Return position and alter
' MenuItem with new ID.
MenuItem = ID
GetMenuItemPosition = i
Exit For
End If
Next i
End Function
Public Sub EnableMenuItem(frm As Form, _
ByVal MenuItem As SysMenuItems, _
Optional ByVal Enabled As Boolean = True)
' This routine is automatically called whenever the
' MinButton, MaxButton, or Movable properties are
' set.
Dim hMenu As Long
Dim nPosition As Long
Dim uFlags As Long
Dim mii As MENUITEMINFO
Const HighBit As Long = &H8000&
' Retrieve handle to system menu.
hMenu = GetSystemMenu(frm.hWnd, False)
' Translate ID to position.
nPosition = GetMenuItemPosition(frm, MenuItem)
If nPosition >= 0 Then
' Initialize structure.
mii.cbSize = Len(mii)
mii.fMask = MIIM_STATE Or MIIM_ID Or MIIM_DATA Or MIIM_TYPE
mii.dwTypeData = String$(80, 0)
mii.cch = Len(mii.dwTypeData)
Call GetMenuItemInfo(hMenu, nPosition, MF_BYPOSITION, mii)
' Set appropriate state.
If Enabled Then
mii.fState = MF_ENABLED
Else
mii.fState = MF_GRAYED
End If
' New ID uses highbit to signify that
' the menu item is enabled.
If Enabled Then
mii.wID = MenuItem
Else
mii.wID = MenuItem And Not HighBit
End If
' Modify the menu!
mii.fMask = MIIM_STATE Or MIIM_ID
Call SetMenuItemInfo(hMenu, nPosition, MF_BYPOSITION, mii)
End If
End Sub
Public Sub setMoveable(frm As Form, ByVal Value As Boolean)
' Toggle SC_MOVE menu appropriately.
Call EnableMenuItem(frm, smMove, Value)
End Sub