How can I determine the dpi zoom settings for the primary monitor?

[MPW]

Hello,

I have used some API code that I pirated off the web years ago and adapted it to display a full screen userform on a 2nd remote monitor.
This worked flawlessly until, laptop default settings began to drift. For years, they recommended (100%), now however they are shipping out 125% or 150%.

This has caused my 2nd display to extend past the edge of the monitor. I did find one post that could accurately deliver the dpi equivalents i.e.

96 – Smaller 100%
120 – Medium 125%
144 – Larger 150%

The problem with this code is it does not track if the zoom is changed unless the system is restarted. This forces the user to restart every time a change is made.
My question: Is there a method to refresh the zoom variable if the workbook is closed and reopened? or better yet every time the userform is opened/showed?

My other question is that I am using a select case statement to resize the 2nd monitor userform. Just wonder if there is a dynamic way to apply the right width? This is important because there are times that monitors are switched out with different sizes.
I did not include any of the code since the one that posted it recognized the fact that it would not refresh. If needed I can post the code. One last thing, The properties left, top, and height are fine, it is only the width that I am struggling with. Hopefully this has a makes sense and has a good answer. Thanks for what you do.

 

[NdNoviceHlp]

Hi MPW. I can relate to your frustration with this. Here's some code to adjust the form and it's controls for both DPI and screen resolution. HTH. Dave
Module code...

Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public X  As Long
Public Y  As Long

Public Type ControlPositionType
    Left As Single
    Top As Single
    Width As Single
    Height As Single
    FontSize As Single
End Type

Public m_ControlPositions() As ControlPositionType
Public m_FormWid As Double
Public m_FormHgt As Double
' Save the form's and controls' dimensions.
Public Sub SaveSizes(UF As Variant)
Dim i As Integer
Dim ctl As Control
    ' Save the controls' positions and sizes.
    ReDim m_ControlPositions(1 To UF.Controls.Count)
    i = 1
        For Each ctl In UF.Controls
        With m_ControlPositions(i)
                .Left = ctl.Left
                .Top = ctl.Top
                .Width = ctl.Width
                .Height = ctl.Height
                On Error Resume Next
                .FontSize = ctl.Font.Size
                On Error GoTo 0
        End With
        i = i + 1
    Next ctl
    ' Save the form's size.
    m_FormWid = UF.Width
    m_FormHgt = UF.Height
End Sub

' Arrange the controls for the new size.
Public Sub ResizeControls(UF As Variant)
Dim i As Integer, ctl As Control
    ' Get the form's current scale factors.
    x_scale = UF.Width / m_FormWid
    y_scale = UF.Height / m_FormHgt
    ' Position the controls.
    i = 1
    On Error Resume Next
    For Each ctl In UF.Controls
        With m_ControlPositions(i)
                ctl.Left = x_scale * .Left
                ctl.Top = y_scale * .Top
                ctl.Width = x_scale * .Width
                ctl.Height = y_scale * .Height
                'no font for spinbtton ie. error
                If InStr(ctl.Name, "SpinButton") = False Then
                If InStr(ctl.Name, "ListBox") Then
                ctl.Font.Size = WorksheetFunction.RoundDown(y_scale * .FontSize, 0)
                Else
                ctl.Font.Size = y_scale * .FontSize
                End If
                End If
        End With
        i = i + 1
    Next ctl
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Resize Controls error"
End If
End Sub

Userform code...

Private Sub UserForm_Initialize()
Dim Wtemp As Double, HTemp As Double
Call SaveSizes(UserForm1) '*****change Userform1 to suit
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
'original design form at 1024 x 768 resolution
Wtemp = (X - 1024) / 1024
'adjust .65 width to suit (form fills %65 of screen width)
Wtemp = 0.65 - Wtemp / 2 * 0.65
HTemp = (Y - 768) / 768
'adjust .9 height to suit (form fills %90 of screen height)
HTemp = 0.9 - HTemp / 2 * 0.9
Me.Width = Application.UsableWidth * Wtemp
Me.Height = Application.UsableHeight * HTemp
End Sub

Private Sub UserForm_Resize()
Call ResizeControls(UserForm1) '*****change Userform1 to suit
End Sub

See the comments to adjust form size. Change the userform name to suit.

 

[MPW]

Thank you NdNoviceHlp, sorry for the delay but I was on vac.
I created a new workbook using your code, but did not quite get what I was looking for.
I use 2 userforms. The 1st is on the primary monitor and has a checkbox control (called "Alt Display") that will open the 2nd userform on a secondary display. The second userform automatically fills the 2nd monitor (both width and height). I thought a couple screen shots might help.

Primary:

Secondary:

As I said before, this code has worked very well for over 15 years regardless of the resolution or size of either monitor. I only began to have problems when the primary monitor does not use 100% zoom. What I would like to query is the zoom factor of the primary monitor and then scale the 2nd form. I hope this helps.

 

[MPW]

I thought I should also add the result when the primary display is 125%.

Thanks

 

[MPW]

I did work through this problem. By using the left and right properties I am able to get the 2nd monitor width. In a nutshell this gave me the answer.

(MONITORINFOEX.rcWork.Right - MONITORINFOEX.rcWork.Left) * 0.7485351

There is more to it, but the UF will now display full screen on the remote monitor (100% - 175%) without regard of the size of the 2nd monitor. If interested I am happy to share the full code that was used. However, it could require some clean up.

 

[NdNoviceHlp]

Thanks for posting your outcome. Dave

 

[MPW]

Thankyou for the input. I did find one caveat with the code. My zoom factor must be set to !00% when I open the workbook, then I can change the zoom to whatever % I want to and it will display correctly. However, if my zoom factor is not set to 100% then my UF width is cut in half. I still count this as a win since the desired results can be obtained.