VBA, MS Access MS Access в примерах

Блокирование кнопки закрытия приложения (API x86 & x64) Class Module

' --------------------------------------------------------------------------------------------------------------
' Name: CloseButton
' Kind: Class Module
' Purpose: 'Блокировка закрытия окна Access
' --------------------------------------------------------------------------------------------------------------
' Пример использования:
' Function InitApplication()
'     Dim c As CloseButton
'     Set c = New CloseButton
'     c.Enabled = False
'     MsgBox "Кнопка закрытия приложения заблокирована", vbInformation, "Function InitApplication"
' End Function
' --------------------------------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

#If Win64 Then
    Private Declare PtrSafe Function GetSystemMenu Lib "user32" _
            (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
    Private Declare PtrSafe Function EnableMenuItem Lib "user32" _
            (ByVal hMenu As LongPtr, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
    Private Declare PtrSafe Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
        (ByVal hMenu As LongPtr, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long

#Else
    Private Declare Function GetSystemMenu Lib "user32" _
            (ByVal hwnd As Long, ByVal wRevert As Long) As Long
    Private Declare Function EnableMenuItem Lib "user32" _
            (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable 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
#End If


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

Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&

Public Property Get Enabled() As Boolean
Dim hwnd As Long
Dim result As Long
Dim MI As MENUITEMINFO
#If Win64 Then
    Dim hMenu As LongPtr
#Else
    Dim hMenu As Long
#End If

    MI.cbSize = Len(MI)
    MI.dwTypeData = String(80, 0)
    MI.cch = Len(MI.dwTypeData)
    MI.fMask = MF_GRAYED
    MI.wID = SC_CLOSE
    hwnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hwnd, 0)
    result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
    Enabled = (MI.fState And MF_GRAYED) = 0
End Property

Public Property Let Enabled(boolClose As Boolean)
Dim hwnd As Long
Dim wFlags As Long
Dim result As Long
#If Win64 Then
    Dim hMenu As LongPtr
#Else
    Dim hMenu As Long
#End If
    hwnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hwnd, 0)
    If Not boolClose Then
    wFlags = MF_BYCOMMAND Or MF_GRAYED
    Else
    wFlags = MF_BYCOMMAND And Not MF_GRAYED
    End If
    result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
End Property
Назад ToTop
L.E. 15.08.2024
Рейтинг@Mail.ru