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

Function InitApplication(intEnab As Boolean)
On Error GoTo err_proc
'Enabled or disables the MS application close (X) button - Dependant on state of intEnab
'Uses Class Module 'Close Command'
Const C_PROC_NAME = "InitApplication"

   Dim C As CloseCommand
   Set C = New CloseCommand
  
   C.Enabled = intEnab
  
exit_proc:
    Exit Function

err_proc:
    MsgBox "Error in Function: '" & C_PROC_NAME & "'" & Chr(13) & err.Description    Resume exit_proc

End Function