TopPicLogo TopPicText

Окно приложения MS Access - Блокирование кнопки закрытия программы

По материалам сайта  Андрея Митина: http://am.rusimport.ru/MSAccess/default.aspx

Код следует поместить в модуль КЛАССА: clsAppCloseButton

'--------------------------------------------------------------------
' Module    : clsAppCloseButton
' Author    : am v1.0.0_000427
' Purpose   : Класс управлениея доступностью кнопки закрытия приложения
'--------------------------------------------------------------------
' ОЧЕНЬ Полезно при разворачивании отчетов или еще чего на весь экран
' Если модуль класса называется clsAppCloseButton код управления будет
' примерно таким:
'-----------------------------------------------------------------------
'    Dim CloseBTN As clsAppCloseButton
'    Set CloseBTN = New clsAppCloseButton
'    CloseBTN.Enabled = False  'Сделать кнопку НЕ доступной
' или
'    CloseBTN.Enabled = True   'Сделать кнопку доступной
'-----------------------------------------------------------------------
'Cсылка на то же самое от Microsoft:
'    http://support.microsoft.com/support/kb/articles/Q245/7/46.asp
Option Compare Database
Option Explicit

Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
    ByVal bRevert 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

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 hMenu As Long
Dim result As Long
Dim MI As MENUITEMINFO
    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 hMenu As Long
Dim result As Long
    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







Ещё один вариант решения данной задачи (Пример)

Прислал: Уфрутов Олег ufrutov@mail.ru

Пример того как можно заставить пользователя закрыть форму только путем нажатия определенной кнопки, а не через Alt+F4 - например.


Picture




Скачать

MSA-2003 ( 19 kB)


Назад ToTop
L.E. 08.12.2016
Рейтинг@Mail.ru