Make application NON-moveable as well as NON-sizeable 1

[Celsoft]

Hi I have a simple MSAccess application which will be "online all day" - the user shouldn't be able to close/minimize/maximize or MOVE the app. window

The code below works for everything except the last-mentioned criterion - i.e. it's still possible to move the darn window around the screen

Any help much appreciated




Option Compare Database
Option Explicit

Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)

Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SIZEBOX = &H40000
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 Const SWP_SHOWWINDOW = &H40

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 HideAccessCloseMinMax()

Dim lngStyle As Long

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

End Sub

 

[PWise]

try this code

Option Compare Database
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_BORDER = &H800000
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED


Public Function ToggleKioskModeAlike()
    Dim NewStyle As Long
Access.RunCommand Access.AcCommand.acCmdAppMaximize
    NewStyle = GetWindowLong(Application.hWndAccessApp, GWL_STYLE) Xor (WS_BORDER + WS_CAPTION)
    SetWindowLong Application.hWndAccessApp, GWL_STYLE, NewStyle
    SetWindowPos Application.hWndAccessApp, 0&, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_DRAWFRAME
    Application.CommandBars("menu bar").Enabled = Not Application.CommandBars("menu bar").Enabled
End Function

 

[Celsoft]

Thanks so much pwise, it works a treat

Just to add for others who might use this ...

I had ToggleKioskModeAlike as my main form's OnActivate event, but then the Menu Bar crept back on closing sub-forms

I changed this to have ToggleKioskModeAlike as the OnCurrent event of my main form and all is well.

Also for others who might use ... don't forget to have a transparent visible command button hidden somewhere inconspicuous in the application to allow administrators to exit the app.

 

[Celsoft]

Ooops - sorry I spoke too soon - events DO cause the unwanted gobbledegook to appear and disappear.

Is there a way to leave things as is without toggling ?

I tried by getting rid of the Application.Commandbars line, but that didn't work