How to Disable X button on Form (win64bit)

[Khalid_Afridi]

Hi Friends!

Anybody knows how to Disable X button on a Form with win64bit configuration (API call)?

The following API call is not working with 64 bit.

Option Explicit
Private Declare Function GetSystemMenu Lib "user32" _
    (ByVal hwnd As Long, _
     ByVal bRevert As Long) As Long
 
.
.
.
.
.

I am using Ms-Access 2010 with 64 bit configuration - windows 7.

Thanks in advance.

 

[SteveSchapel]

Khalid,

Doesn't it work to just set the Close Button property of the form to No?

 

[Khalid_Afridi]

Hi Steve Schapel!

I don't want to disable the button on the form, I just want to disable the X button (clsoe button) on the Ms-Access Database window on the top right cornner to close/exit the Access Application entirely. I dont want the users to close the Application throught this X button. I want them to close the application propperly through EXIT button on the form.

Behinde the EXIT Button on the form click event, I have written some codes to be exicute while exitng the application.

Hope this make sence.
Thanks

 

[ghudson]

The code I used to use with Access 2003 to disable the application close X button does not work well with Access 2007. My work around was to use the below code in the Form_Unload event for each form.

Dim booCloseForm As Boolean

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Err_Form_Unload

    If booCloseForm = False Then
        Cancel = True
        MsgBox "You must use the Close Database button to exit the database!", vbCritical, "Invalid Close Database Attempt"
    End If

Exit_Form_Unload:
    Exit Sub

Err_Form_Unload:
        MsgBox Err.Number & " - " & Err.Description, vbCritical, "Form_Unload()"
        Resume Exit_Form_Unload

End Sub

To allow the database to be closed, I set the booCloseForm to True in my custom Close database button.

booCloseForm = True
DoCmd.RunCommand acCmdExit

HTH

 

[Khalid_Afridi]

That's a nice idea Mr. ghudson!

but I have some senarios with my application. consider the following:

• I have written some codes which close the application automatically when nobody is using it for 30 minutes.
• I want to close the application (kick-out all or some selected users from the applicaition for maintenance purpose) from Admin panel.

so in this case it will be very difficult to close the client side applicaiton from Admin panel.
what's your openion please?

 

[ghudson]

You kickout function will still work as long as you set the booCloseForm = True before you run your DoCmd.RunCommand acCmdExit command [or what ever code you are using] to close the database.

 

[Khalid_Afridi]

I have written the following code on my my main form on timer event to kick-out any user from the application:

If Exit_user() = True Then
    Call SaveUserInfo("out") 'save user info
    Application.Quit acSaveYes
End If

The Exit_user() function check the following:

Public Function Exit_user() As Boolean
     Dim strSQL As String
     Dim db As DAO.Database
     Dim rsSQL As DAO.Recordset
     Set db = CurrentDb
    
     strSQL = "SELECT ID, tmpUserID, UserLogout From TempUser_T WHERE tmpUserID =" & TempVars!gUserID
     strSQL = strSQL + " AND UserLogout = False"
     
     Set rsSQL = db.OpenRecordset(strSQL, dbOpenSnapshot)
   
     If rsSQL.RecordCount > 0 Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "UPDATE TempUser_T SET  TempUser_T.UserLogout = -1 WHERE TempUser_T.tmpUserID = " & TempVars!gUserID
        DoCmd.SetWarnings True
       Exit_user = True
    
    End If
    rsSQL.Close
    Set rsSQL = Nothing


End Function

This function checks if the tmpUserID is inserted in the TempUser_T table for kicking him/her out? if yes he will be out from the Application.

Meanwhile the Call SaveUserInfo("out") 'save user info function is saving the user info to a log table the code is the following:

Public Function SaveUserInfo(in_out As String)
Dim strSQL As String
Dim nid As Long
Dim rs As DAO.Recordset
If in_out = "in" Then

   
    strSQL = "INSERT INTO tblLogReg (EmpNo, sUserName, sHostName,ApplicationName)"
    strSQL = strSQL + "VALUES ("
    strSQL = strSQL + "'" & TempVars!gUserID & "', "
    strSQL = strSQL + "'" & TempVars!gDomainUser & "', "
    strSQL = strSQL + "'" & TempVars!gMachineName & "', "
    strSQL = strSQL + "'" & TempVars!gAppName & "' )"

    CurrentDb.Execute (strSQL)
    
    strSQL = "SELECT tblLogReg.EmpNo, tblLogReg.ApplicationName, Max(tblLogReg.LogRegID) AS nlogregID,"
    strSQL = strSQL & " tblLogReg.sHostName FROM tblLogReg"
    strSQL = strSQL & " GROUP BY tblLogReg.EmpNo, tblLogReg.ApplicationName, tblLogReg.sHostName"
    strSQL = strSQL & " HAVING (tblLogReg.EmpNo=" & TempVars!gUserID
    strSQL = strSQL & " AND tblLogReg.ApplicationName='" & TempVars!gAppName & "'"
    strSQL = strSQL & " AND tblLogReg.sHostName='" & TempVars!gMachineName & "')"
    
    
    
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
   
    If rs.RecordCount > 0 Then
        nid = rs!nLogRegID
        TempVars!gLogRegID = nid
    End If
   
    rs.Close
    Set rs = Nothing
ElseIf in_out = "out" Then
    strSQL = "UPDATE tblLogReg SET tblLogReg.StampDateOut = Date(), tblLogReg.StampTimeOut = Time()"
    strSQL = strSQL & " WHERE tblLogReg.LogRegID=" & TempVars!gLogRegID
    
    CurrentDb.Execute (strSQL)

End If
End Function

This function save the user information to tblLogReg table:

Now if user close the form directly from X button, this function not run and the user's Save out information is not recorded to the tblLogReg table, and its look like that he is still logged in to the application.

so where booCloseForm = True as per your suggestion can be set? moreover if user is not in the main form how can we set booCloseForm = True through the above code?

any suggestion?

 

[boblarson]

I am using Ms-Access 2010 with 64 bit configuration - windows 7.

Thanks in advance.

Just a reminder to everyone - if you are going to use 64 bit programs then you need to use 64 bit API's (not many have been written or modified yet to work with 64 bit so you are out there a bit on your own).

CORRECTION -

You can run 32 bit API's with 64 bit apps, but you need to do a slight modifcation in how you call them. See the post to the UA thread below that I posted.

 

[Khalid_Afridi]

Yes its really a BIG problem now, I remove all my 32bit API calls from my Application, coz its not working with 64bit configuration. now the problem is I am not able to find out any 64bit function on the net

 

[boblarson]

Check out this thread on UA.

 

[Khalid_Afridi]

hmmmm, so when VBA7 is releasing? I am exited

 

[boblarson]

hmmmm, so when VBA7 is releasing? I am exited

Already here inside Access 2010, if I remember correctly.

 

[Khalid_Afridi]

I hope someone can change the following win32 bit API call to 64bit very soon:

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

Private Const WS_SYSMENU = &H80000

Private Const HWND_TOP = 0
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED

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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex 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 Long

Sub HideAccessCloseButton()

    Dim lngStyle As Long

    lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE)
    lngStyle = lngStyle And Not WS_SYSMENU
    Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle)
    Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME)

End Sub

 

[boblarson]

Well, if you read the thread closely you should have noticed Banana's (Banana Republic there) mention of using PtrSafe in order for it to work.

So, changing these:

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

to these:

Private Declare [COLOR="Red"][B]PtrSafe[/B][/COLOR] Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
   ByVal bRevert As Long) As Long

Private Declare [COLOR="Red"][B]PtrSafe[/B][/COLOR] Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

Private Declare [COLOR="Red"][B]PtrSafe[/B][/COLOR] Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long

 

[Khalid_Afridi]

Hi Bob!
Yeah! I have noticed these

Type	 Item	 Description
Qualifier

PtrSafe

Indicates that the Declare statement is compatible with 64-bits. This attribute is mandatory on 64-bit systems.

Data Type

LongPtr

A variable data type which is a 4-bytes data type on 32-bit versions and an 8-byte data type on 64-bit versions of Office 2010. This is the recommended way of declaring a pointer or a handle for new code but also for legacy code if it has to run in the 64-bit version of Office 2010. It is only supported in the VBA 7 runtime on 32-bit and 64-bit. Note that you can assign numeric values to it but not numeric types.

Data Type

LongLong

This is an 8-byte data type which is available only in 64-bit versions of Office 2010. You can assign numeric values but not numeric types (to avoid truncation).

Conversion Operator

CLngPtr

Converts a simple expression to a LongPtr data type.

Conversion Operator

CLngLng

Converts a simple expression to a LongLong data type.

Function

VarPtr

Variant converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).

Function

ObjPtr

Object converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).

Function

StrPtr

String converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).

I am confused and did not give yet a try. I will try it in the office and will see what happens. If my computer starts dancing then I have to sing a song (just kidding)

anyhow thanks a lot.