Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Control multiple monitor display using VBA 1

Status
Not open for further replies.

ridders52

Programmer
Aug 7, 2017
16
GB
Hi

I have found various code to control multiple monitors displays e.g. using C# or VB
e.g. [URL unfurl="true"]http://www.tek-tips.com/viewthread.cfm?qid=1669894[/url]

However, I want to do this using VBA in Access.
My goal is to disable the 2nd monitor programmatically
Ideally it would be 'Show Monitor 1 only' but 'Duplicate Displays' would suffice if necessary
See attached info

I know how to get monitor info using both GetSystemMetrics & EnumDisplayMonitors APIs
I also know how to change resolution using ChangeDisplayEx API

However I've hit a brick wall on changing the overall dual monitor display settings
Can anyone assist please
 
I've never delved into that myself, but I think you'd have a couple of variations to think of / account for, possibly:
1. Different versions of Windows
2. Different graphics drivers
3. Possibly (as always) different versions of Office - though this would be the smallest problem with this type project, I'm sure.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
disable the 2nd monitor programmatically" - I hope you have VERY, VERY good reason to do so. Otherwise you will get a lot of po'd users
The same would apply to "change resolution"

Could you share your reasons?

Have fun.

---- Andy

There is a great need for a sarcasm font.
 
Hi

Here's a detailed reply to you both...

@Andrzejek
It's a request from a client for a kiosk style database
For reasons of their own, they want a highly locked down database where users cannot 'escape' the database when it is open.
That's to overcome issues they've had in the past
Their users might indeed be pissed off but that's the client's decision

So far, I have done the following (and more):
1. Created a user form which completely fills the screen - taskbar, nav pane, ribbon, title bar, application window etc are all hidden
2. No command buttons
3. Disabled all but a limited number of key entries on the keyboard but leaving a specific combination to close the program or go to settings screen
4. The settings screen can only be accessed if the program is run as an administrator.
5. Added code to the settings screen to disable keyboard combinations such as Ctrl+Esc, Alt+Tab; Ctrl+Alt+Del; Ctrl+E any of which would allow users to 'escape'
This is done by editing the registry

So far it all works perfectly!
Its highly secure & nobody has managed to 'break' it in testing

Once the program is closed, the screen & keyboard return to 'normal'

I could change the resolution using VBA if I wanted, but that's not relevant here

Actually it was quite fun solving all the above challenges - the registry changes were the only bit I had to learn
There is a great need for a sarcasm font.
I agree - how about Comic Sans !! [dazed]

After I'd finished they said, some of the users have dual monitors. Aaarrrggghhh!
So I need to disable monitor 2 programmatically whilst the program is in use.
To do this I need to use APIs such as those listed in the first post
Now its no longer fun as it seems few have tried & nobody has succeeded in doing this (unless they've never mentioned it online...)

@kvj1611
I don't believe any of the things you raised are relevant here as I'm just wanting to disable monitor 2 in a dual monitor display.
Normally this is done using Control panel (or Settings in Windows 10)
I can detect each monitor using VBA & get the screen size & resolution
The settings would only apply for PCs with more than one monitor

I'm not changing resolution etc so the graphics drivers aren't an issue.
I'm using windows APIs so the Office / Windows versions also don't matter.

Colin
 
I'm not changing resolution etc so the graphics drivers aren't an issue.
> Most likely, you won't run into issues, but keep it in mind for troubleshooting. Different hardware can behave differently.
I'm using windows APIs so the Office / Windows versions also don't matter.
> Are you telling me you honestly believe Microsoft hasn't changed APIs throughout the different versions of Windows? Surely Windows 10 has some different APIs than XP, for instance.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
@kjv1611

OK I accept that until I test it on a variety of setups I won't know for sure...

I'm not saying that APIs haven't changed.

However , one thing at a time

The first task is to see if I can get this to work on my Windows 10 dual monitor system.
If I can, then I'll test it on other versions of Windows ... as well as other computers / Access versions etc

 
I'm in the camp that's against disabling the monitor (although it definitely can be done through ChangeDisplayEx (or SetDisplayConfig in W7 and later), as long as you know the right magic invocation, e.g see this discussion)

I'd take a different approach and consider limiting the mouse to the primary monitor via ClipCursor API call

>you honestly believe Microsoft hasn't changed APIs throughout the different versions of Windows? Surely Windows 10 has some different APIs than XP, for instance.
Sure, it has some new and some extended APIs, yes - but pretty much all the Win32 API calls from XP (and before) work on Windows 10. I have heavily API-calling code I wrote for Windows 98 that still runs perfectly unchanged on Windows 10.
 
Many thanks for the link strongm which I will investigate further
That's one I hadn't found with various google searches

Your suggestion of limiting the mouse to the primary monitor is another route to investigate
Do you have a link to any code for that as well?

 
APIs: My main thought is: You build it on a Win10 machine, and then send it to a WinXP or Win7 machine. Just make sure you're not using something they didn't have on the older OSes. I have no idea what OS you're building on, just tossing out a possibility.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
I've already checked which Windows & Access versions are in use by the client.
That was done before starting this project.
 
Here's an example I've knocked together to demonstrate the principle. It uses a UserForm with a single COmmand button on it. Please be aware that the ClipCursor is a globally shared resource, it is not yours exclusively. If other apps get a look-in then they can change it. They normally do this during a SetFocus or SetWindowsPos API call, so if your program ever lets other programs get the focus, or allow them to move a window (even if that move is simply through the z-order), then you lose the ClipCursor. Given the description of your app, this should not present a problem.

Code:
[blue]Option Explicit

Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long,  lpRect As RECT) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

Private Sub UserForm_Activate()
    Dim hwnd As Long
    Dim Client As RECT
   
    CommandButton1.Caption = "Release Cursor"
    Me.Caption = "ClipCursor Example"
    hwnd = FindWindow(vbNullString, Me.Caption) [green]' Deal with fact VBA userforms do not have exposed hWnd[/green]
    GetWindowRect hwnd, Client [green]'get window bounds[/green]
    ClipCursor Client [green]' Restrict cursor to window represented by hWnd[/green]
End Sub

Private Sub CommandButton1_Click()
    [green]' Release cursor limits[/green]
    ClipCursor ByVal 0&
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    [green]' Release cursor limits[/green]
    ClipCursor ByVal 0&
End Sub[/blue]
 
Thanks strongm
Busy today but will test this out in next couple of days and report back

Colin
 
Hi strongm

Just tested the code you provided using ClipCursor API

In a new form with just a single button, the cursor certainly disappeared BUT on both monitors so I couldn't click the button to release it again
However moving the mouse around and clicking repeatedly, the cursor reappears eventually which isn't any good ...
Not quite sure what triggers it to return (as I have no cursor!!!! [bigsmile])

Closing the form using the keyboard also restores the cursor
I've never heard of a Form_QueryClose event before ... did you just mean Form_Close?

Anyway, next I tried the same code in the 'real' form & it doesn't do anything at all.
That may be because I have set startup properties in that form as below:

Code:
Function StartUpProps(strPropName As String, Optional varPropValue As Variant, _
        Optional ddlRequired As Boolean) As Variant
    
' This function requires a reference to DAO library.
' This function will both return and set the value of startup properties
' in your database. It can also be used for other database properties
' with some slight modification.
    
    Dim db As DAO.Database, prp As DAO.Property, varPropType As Variant
    Const conPropNotFoundError = 3270
    
    strProc = "StartUpProps"
    
    If IsMissing(ddlRequired) Then
        ddlRequired = False
    End If
    
    ' Because this code is specific to the startup properties, we assume that the
    ' data type of the property is Boolean unless stated otherwise.
    
    varPropType = dbBoolean
    
    Select Case strPropName
    
    Case "frmStart"
        varPropType = dbText
    End Select
    
    Set db = CurrentDb
    
    ' This function will either set the value of the property or try to
    ' return it. It knows which mode it is in by the existence of the
    ' property value in the procedure that called the function.
    
    If Not IsMissing(varPropValue) Then
    
        ' As we change the value of the startup property, we will first try to
        ' assign that value. If the property does not exist, it will be
        ' added to the database object by using the following error handling code.
        On Error GoTo AddProps_Err
        db.Properties(strPropName) = varPropValue
        StartUpProps = True
    Else
        ' If we find out the value of the startup property, we first see if
        ' that value exists. If the property does not exist, we will return a null string.
        On Error GoTo NotFound_Err
        StartUpProps = db.Properties(strPropName)
    End If
    
Exit_Handler:
    On Error Resume Next
    Set db = Nothing
    Set prp = Nothing
    Exit Function
    
    'When a property doesn't exist in the database, you must use the CreateProperty method to add the property
    'to the database. The error handling section of the sub-routine handles this method as follows:
    
AddProps_Err:
    If Err = conPropNotFoundError Then
        ' Property not found when adding a property value.
        Set prp = db.CreateProperty(strPropName, varPropType, varPropValue, ddlRequired)
        db.Properties.Append prp
        Resume Next
    Else
        ' Unknown error.
        StartUpProps = False
        MsgBox "Error " & Err.Number & " in " & strProc & " procedure : " & Err.Description
        Resume Exit_Handler
    End If
    
NotFound_Err:
    If Err = conPropNotFoundError Then
        ' Property not found when returning a property value.
        StartUpProps = Null
        Resume Next
    Else
        ' Unknown error.
        StartUpProps = False
        MsgBox "Error " & Err.Number & " in " & strProc & " procedure : " & Err.Description
        Resume Exit_Handler
    End If

End Function

Function DeleteStartupProps(strPropName As String) As Boolean
' Function requires a reference to DAO library.
 
Dim db As DAO.Database, prp As DAO.Property
Const conPropNotFoundError = 3270
 
DeleteStartupProps = False

On Error GoTo Err_Handler

CurrentDb.Properties.Delete (strPropName)
DeleteStartupProps = True

Exit_Handler:
   On Error Resume Next
   Set db = Nothing
   Set prp = Nothing
   Exit Function
 
Err_Handler:
   If Err = conPropNotFoundError Then
      ' Property not found.
      DeleteStartupProps = False
      Resume Next
   Else
      'Unknown error.
      strProc = "DeleteStartupProps"
      MsgBox "Error " & Err.Number & " in " & strProc & " procedure : " & Err.Description
      Resume Exit_Handler
   End If

End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo Err_Handler

'Used to disable selected individual input key values
'NOTE: Selected key combinations can be disabled in the registry e.g. Alt+Tab, Ctrl+Alt+Del, Ctrl+Esc, Win+E
'This is done from the form frmSettings
  
 Select Case Shift
    
    Case acCtrlMask
      'Control pressed - allow it
      
        If KeyCode = vbKeyV Then
            MsgBox "Sorry - pasting text is not allowed on this form", vbCritical, "ERROR"
            KeyCode = 0
        End If
        
        If KeyCode = vbKeyC Then
           ' MsgBox "Sorry - copying text is not allowed on this form", vbCritical, "ERROR"
            KeyCode = 0
        End If
      
        'Exit Sub
        
    Case acAltMask
      'Alt pressed - don't allow it
        KeyCode = 0
        
    Case acShiftMask
      'Shift pressed - don't allow it (on its own)
        'Exit Sub
        KeyCode = 0 'v1.7
        
    End Select
        
    
    Select Case KeyCode

    Case vbKeyT 'allow
        Exit Sub
        
    Case vbKeyK 'allow
        Exit Sub
        
    Case vbKeyQ 'allow
        Exit Sub
        
    Case vbKeyS 'allow
        Exit Sub
        
    Case vbKeyP 'allow
        Exit Sub
    
    Case vbKeyTab
        'Tab pressed - don't allow it
        KeyCode = 0
        
    Case vbKeyEscape
        'Esc pressed - don't allow it
        KeyCode = 0
        
    Case vbKeyDelete
        'Del pressed - don't allow it
        KeyCode = 0
        
   'These refer to keys on the numeric keypad
    Case vbKeyAdd
        '+ pressed - don't allow it
        KeyCode = 0
        
    Case vbKeyMultiply
        '* pressed - don't allow it
        KeyCode = 0
        
    Case vbKeySubtract
        '- pressed - don't allow it
        KeyCode = 0
        
    Case vbKeyDivide
        '/ pressed - don't allow it
        KeyCode = 0
        
    Case vbKeyDecimal
        '. pressed - don't allow it
        KeyCode = 0
                    
    Case Else
       ' Debug.Print KeyCode
        KeyCode = 0
        
    End Select
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " in Form_KeyDown procedure : " & Err.Description
    Resume Exit_Handler
    
End Sub

Private Sub Form_Load()

On Error GoTo Err_Handler

    DoCmd.Maximize
    SetAccessWindow (SW_SHOWMINIMIZED) 'hides main Access window so only the form is displayed
   
    HideNavigationPane 'does just that ...
    HideTaskbar 'ditto ....

    'By default, set all start up properties to False
    
    'next section for use during development only
    If GetBypassKeySettings = False Then
        StartUpProps "AllowBypassKey", False, True
    Else
        StartUpProps "AllowBypassKey", True, True
    End If
    
    StartUpProps "AllowFullMenus", False, True
    StartUpProps "StartUpShowStatusBar", False, True
    StartUpProps "AllowBuiltInToolbars", False, True
    StartUpProps "AllowShortcutMenus", False, True
    StartUpProps "AllowToolbarChanges", False, True
    StartUpProps "AllowSpecialKeys", False, True
    StartUpProps "StartUpShowDBWindow", False, True
    
    CheckScancodeMap 'checks if 'special keys' are disabled in registry
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " in Form_Load procedure : " & Err.Description
    Resume Exit_Handler
    
End Sub

I tried moving your Form_Activate code into Form_Open so it ran before my existing Form_Load code.
It still had no effect i.e. I still had a cursor
Any thoughts?
 
>the cursor certainly disappeared

Er, the cursor should NOT disappear.

>I've never heard of a Form_QueryClose event before

As I stated in the preamble, the example uses a UserForm, not an Access form.

I now feel I probably also need to point out that the example is simply to illustrate the technique. It is not production code, nor bullet proof (as I also pointed out)
 
Hi strongm

I've now managed to get this to work in a standard Access form and have effectively achieved my aim of disabling the secondary monitor
Unfortunately I haven’t managed to master the intricacies of the display settings API
Instead I’ve restricted the mouse to the active form window as you suggested

Attached is a link to a DEMO of this in action if you would like to try it. It's a zipped accdb file: Multi Monitors.zip
It includes some of the features included in my kiosk style database though I’ve left out most of the keyboard restrictions and some other security features

Its not finished – error handling isn’t complete & there is some overlapping code in different modules to be sorted out.
However it does compile and you will be able to see it working

On opening the db in a trusted location, a floating screen appears on a blank desktop
There is no application window / taskbar / desktop icons / ribbon or navigation pane though all can be restored via the command buttons

NOTE: all screen settings return to normal when you close the database

Capture_iabuwc.png


In this DEMO, the mouse cursor can initially move anywhere including to the secondary monitor
Click Disable Cursor & it is limited to the active form thus effectively disabling the secondary monitor.
The cursor IS still visible - no idea what happened before

In the DEMO, you can also alter the resolution of either monitor – at the moment these changed values are hard coded.
If the values aren’t allowed on your monitor(s) nothing will happen

In my actual kiosk db, it opens maximised & full screen with no application window / taskbar / desktop icons / ribbon or navigation pane.
There are also no command buttons on the form
The cursor will be disabled when it opens so preventing the user doing anything outside the active form.

If you do try it, I would be grateful for any feedback or suggestions for improvement

Many thanks for your help - if you hadn't suggested restricting the cursor to the active window I would still be stuck!

Colin
 
Just curious...

In Form_KeyDown event, wouldn't this be enough?

Code:
Select Case KeyCode
    Case vbKeyT, vbKeyK, vbKeyQ, vbKeyS, vbKeyP
        Exit Sub
    Case Else
        KeyCode = 0
End Select

Have fun.

---- Andy

There is a great need for a sarcasm font.
 
Hi Andy

I've made a few minor changes to this DEMO database - version 2 attached if anyone is interested Multi Monitors v2.zip

1. On opening the db, the cursor is restricted to the active form & all buttons are disabled except Enable Cursor & Quit.

MultiMonitors_v2_tt6od9.png


Clicking Enable Cursor also enables all buttons

2. Added code to minimise all external application windows whilst db is open. Restored when db is closed

3. The Form_KeyDown event code was a leftover from earlier code when I had problems with ClipCursor.
For the purposes of this DEMO, it doesn't matter whether the keyboard is enabled or not as its not used.
Yes I could have shortened the code but I've now disabled the Form_KeyDown event as its not serving any real purpose here

However, you'll see it is easy to 'escape' the form window by clicking e.g. Win+E; Alt+Tab, Ctrl+Alt+Esc
For my kiosk style db, the keyboard is highly locked down for both individual keys and combinations like all those above
This requires registry changes which only take effect after restarting Windows

4. I've not bothered to disable wallpaper as its not an issue as far as I can see.
However I do have code for that as well if needed

EDIT
In my last 2 posts, I've tried to upload the file as an attachment to the post.
It failed so I've used an external URL

Each time I try, I select & upload the selected file but nothing appears with the post.
It worked with the first post in this thread but isn't now
Is this a forum glitch or am I being dumb?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top