Results 1 to 14 of 14

Thread: Screen scaling issue....

  1. #1

    Thread Starter
    Member
    Join Date
    Jul 2010
    Posts
    54

    Screen scaling issue....

    Hi All,

    I use some simple code to determine the screen resolution of the target PC my app will run on:

    iXRes = Screen.Width / TwipsPerPixelX
    iYRes = Screen.Height / TwipsPerPixelY

    If the screen resolution is too low I show a warning to the user.

    My issue is that recently, the above code doesn't seem to work on certain PC's. On further investigation, I found that the .Width and .Height values are off by 2.5x in these cases. I further noticed that the display properties on the problem machine have a 'Scale Factor' setting set to 250%..... So, this setting is clearly the reason the above code isn't returning the correct values.

    I've read a lot of the screen scaling threads that discuss similar issues, but they don't really seem relevant as my application does not allow resizing. I just simply need a way to determine the true screen resolution when launching my app.

    Thanks!

    Jack

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Screen scaling issue....

    If you don't manifest your application to be DPI aware, then you will always get screen coordinates relative to 96 DPI (100%).

    If DPI is 250% (quite large) but your app thinks it is 100%, then it would make sense your values are off ~2.5x. Without DPI awareness, Windows scales the actual values down to 100%.

    You can get the actual dimensions via APIs. Here are a couple of functions
    Code:
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    
    ' Note: When DPI virtualization exists, HORZRES,VERTRES return virtualized values
    
    Public Property Get ScreenWidth(Optional ByVal Actual As Boolean) As Single
        ' returned as Twips
        If Actual Then
            Dim hDC As Long: hDC = GetDC(0)
            ScreenWidth = GetDeviceCaps(hDC, 118) * Screen.TwipsPerPixelX ' 118=DESKTOPHORZRES
            ReleaseDC 0, hDC
        Else
            ScreenWidth = Screen.Width
        End If
        
    End Property
    
    Public Property Get ScreenHeight(Optional ByVal Actual As Boolean) As Single
        ' returned as Twips
        If Actual Then
            Dim hDC As Long: hDC = GetDC(0)
            ScreenHeight = GetDeviceCaps(hDC, 117) * Screen.TwipsPerPixelY ' 117=DESKTOPVERTRES
            ReleaseDC 0, hDC
        Else
            ScreenHeight = Screen.Height
        End If
    End Property
    
    Public Property Get ScreenDPI(Optional ByVal Actual As Boolean) As Single
        If Actual Then
            Dim hDC As Long: hDC = GetDC(0)
            ScreenDPI = GetDeviceCaps(hDC, 118) / (Screen.Width / Screen.TwipsPerPixelX)
            ReleaseDC 0, hDC
            If ScreenDPI = 1 Then
                ScreenDPI = 1440! / Screen.TwipsPerPixelX
            Else
                ScreenDPI = ScreenDPI * 96!
            End If
        Else
            ScreenDPI = 1440! / Screen.TwipsPerPixelX
        End If
    End Property
    FYI: I started a tutorial awhile back (needs to be updated), but you can find more info, including those methods above, there:
    http://www.vbforums.com/showthread.p...eing-DPI-Aware
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Screen scaling issue....

    Cut out of a Gen_Monitors.bas module I use frequently:

    Code:
    
    Option Explicit
    '
    Private Type RECT
        Left   As Long
        Top    As Long
        Right  As Long ' This is +1 (right - left = width)
        Bottom As Long ' This is +1 (bottom - top = height)
    End Type
    Private Type MONITORINFO
        cbSize As Long
        rcMonitor As RECT
        rcWork As RECT
        dwFlags As Long
    End Type
    '
    Private Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long
    Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
    Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hDC As Long, lprcClip As Any, ByVal lpfnEnum As Long, dwData As Long) As Long
    '
    
    Public Function MonitorWidthPx(hMonitor As Long, Optional bUseWorkingArea As Boolean) As Long
        Dim uMonInfo As MONITORINFO
        '
        uMonInfo.cbSize = LenB(uMonInfo)
        If GetMonitorInfo(hMonitor, uMonInfo) = 0 Then Exit Function
        '
        If bUseWorkingArea Then ' The "Work" verions exclude the taskbar.
            MonitorWidthPx = uMonInfo.rcWork.Right - uMonInfo.rcWork.Left
        Else
            MonitorWidthPx = uMonInfo.rcMonitor.Right - uMonInfo.rcMonitor.Left
        End If
    End Function
    
    Public Function MonitorHeightPx(hMonitor As Long, Optional bUseWorkingArea As Boolean) As Long
        Dim uMonInfo As MONITORINFO
        uMonInfo.cbSize = LenB(uMonInfo)
        If GetMonitorInfo(hMonitor, uMonInfo) = 0 Then Exit Function
        '
        If bUseWorkingArea Then ' The "Work" verions exclude the taskbar.
            MonitorHeightPx = uMonInfo.rcWork.Bottom - uMonInfo.rcWork.Top
        Else
            MonitorHeightPx = uMonInfo.rcMonitor.Bottom - uMonInfo.rcMonitor.Top
        End If
    End Function
    
    
    
    Public Function hMonitorForForm(frm As Form) As Long
        ' The monitor that the window is MOSTLY on.
        Const MONITOR_DEFAULTTONULL = &H0
        hMonitorForForm = MonitorFromWindow(frm.hWnd, MONITOR_DEFAULTTONULL)
    End Function
    
    Public Function hPrimaryMonitor() As Long
        ' This is the primary monitor.
        EnumDisplayMonitors 0&, ByVal 0&, AddressOf PrimaryMonitorHandleEnum, hPrimaryMonitor
    End Function
    
    Public Function MonitorCount() As Long
        ' This does NOT count disabled monitors.
        EnumDisplayMonitors 0&, ByVal 0&, AddressOf MonitorCountEnum, MonitorCount
    End Function
    
    
    
    
    
    Private Function PrimaryMonitorHandleEnum(ByVal hMonitor As Long, ByVal hdcMonitor As Long, uRect As RECT, dwData As Long) As Long
        Const MONITORINFOF_PRIMARY = &H1
        Dim uMonInfo As MONITORINFO
        uMonInfo.cbSize = LenB(uMonInfo)
        GetMonitorInfo hMonitor, uMonInfo
        If uMonInfo.dwFlags = MONITORINFOF_PRIMARY Then
            dwData = hMonitor
            PrimaryMonitorHandleEnum = 0 ' Found it.
        Else
            PrimaryMonitorHandleEnum = 1 ' Keep looking.
        End If
    End Function
    
    Private Function MonitorCountEnum(ByVal hMonitor As Long, ByVal hdcMonitor As Long, uRect As RECT, dwData As Long) As Long
        dwData = dwData + 1
        MonitorCountEnum = 1 ' Count them all.
    End Function
    
    
    
    In addition to the monitor sizes, I also gave you a couple of functions for figuring out the hMonitor of various monitors.

    EDIT: And yeah, if you want twips, that gets a bit trickier. But it looks like you're wanting pixels.

    EDIT2: And, just to give an example:

    Code:
    
    Private Sub Form_Load()
        Debug.Print MonitorWidthPx(hMonitorForForm(Me))
        Debug.Print MonitorHeightPx(hMonitorForForm(Me))
    End Sub
    
    
    And also, that optional bUseWorkingArea will subtract the taskbar, wherever it might be and however it's stretched out.

    EDIT3: And personally, I don't use the Screen object for anything anymore other than enumerating fonts. With later versions of Windows, it's just got too many problems.
    Last edited by Elroy; May 5th, 2020 at 03:33 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  4. #4

    Thread Starter
    Member
    Join Date
    Jul 2010
    Posts
    54

    Re: Screen scaling issue....

    Hi All,

    OK, thanks for the replies! These suggestions look exactly like what I'm after!

    Much thanks!

    Jack

  5. #5
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Screen scaling issue....

    @Elroy. Don't think your routines will work if app is not DPI aware.
    Run it and get the screen size
    Now change the DPI to 150% and get the screen size. It shouldn't change size but the screen shrunk, according to your routines !!
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  6. #6
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Screen scaling issue....

    Ok, I don't have anything manifested, not my IDE and not the little test program I wrote. If it's not compiled, things are a bit funky, but that's just the IDE. Once compiled, everything works as I'd expect.

    First, I change my little test code to the following:

    Code:
    
    Private Sub Form_Click()
        MsgBox MonitorWidthPx(hMonitorForForm(Me)) & vbCrLf & MonitorHeightPx(hMonitorForForm(Me))
    End Sub
    
    Ok, my hardware setup. I currently have two monitors, both 1920x1080. I run the compiled program on my primary and get:

    Name:  Clip1.png
Views: 823
Size:  4.1 KB

    I move the form to my second monitor and get the same thing, as expected.

    And then, while still running my little program, I change my secondary monitor to 150%, and get the following:

    Name:  Clip2.png
Views: 854
Size:  8.3 KB

    That's what I'd want. So, I'm confused about what the problem is.

    EDIT: And, IDK, but in my mind, once we set to 150%, the screen DID shrink, at least in terms of the pixels it has, or, at least in terms of the pixels it has that VB6 can mess with.

    EDIT2: Granted, we can get into a whole discussion of physical pixels versus virtual pixels. However, in terms of programming, it seems that it's only virtual pixels that matter. Otherwise, we're back into a discussion of all that EDID information, which I wouldn't look forward to, as I've never been able to make that stuff work correctly.
    Last edited by Elroy; May 5th, 2020 at 05:26 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  7. #7
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Screen scaling issue....

    Quote Originally Posted by Elroy View Post
    That's what I'd want. So, I'm confused about what the problem is.
    If they are both 1920x1080, then why do you have different results? Your results are no different than Screen.Width/Screen.TwipsPerPixel (if run on the same monitor @ different DPIs). And to expand that, the OP's question wouldn't be resolved, since Screen.Width / Screen.TwipsPerPixelX would return the different values in both scenarios, even though the screens are identically sized. That, in a nutshell, is what is prompted the question... " I just simply need a way to determine the true screen resolution..."
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  8. #8
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Screen scaling issue....

    Ok, first, LaVolpe, please read my edits to post #6.

    From a program's perspective, it would seem that the pixels could change, depending on the scale setting. If we set our form to have a pixel scalemode, and also change the little test procedure to the following:

    Code:
    
    Private Sub Form_Click()
        Me.ScaleMode = vbPixels
        MsgBox MonitorWidthPx(hMonitorForForm(Me)) & vbCrLf & MonitorHeightPx(hMonitorForForm(Me)) & vbCrLf & Me.ScaleWidth
    End Sub
    
    
    And then, I take my (compiled) program to my 150% second monitor, and stretch it out to about the screen width, and click it, here's what I get:

    Name:  Clip3.png
Views: 818
Size:  7.1 KB

    So, from VB6's perspective, all I've got is 1280 pixels width, and I'm using 1268 of them. I guess we need to define what we mean by "true screen resolution", physical or virtual. From VB6's perspective, I'm not sure what use physical pixels are.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  9. #9
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Screen scaling issue....

    Maybe Jack will jump back in.

    Jack, do you want to know how many pixels are available to your program? Or do you want to know the native pixel resolution of the actual monitor? And those are two different questions.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  10. #10
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Screen scaling issue....

    And ok, yeah, it requires manifesting to get a correct scaling number. Here's code I've got that could be used in conjunction with MonitorWidthPx and MonitorHeightPx to get the physical pixel counts. As noted in the comments (and as pointed out by LaVolpe), it does require manifesting:

    Code:
    
    Option Explicit
    '
    Private Declare Function GetScaleFactorForMonitor Lib "shcore.dll" (ByVal hMonitor As Long, ByRef pScale As Long) As Long
    Private Declare Function GetModuleHandleW Lib "kernel32.dll" (ByVal lpModuleName As Long) As Long
    Private Declare Function LoadLibraryExW Lib "kernel32.dll" (ByVal lpFileName As Long, ByVal hFile As Long, ByVal dwFlags As Long) As Long
    Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
    '
    
    Public Function MonitorScaleFactor(hMonitor As Long) As Single
        ' If we don't have the GetScaleFactorForMonitor call, just return 1, as it's probably an old version of Windows.
        '
        ' For this to be correctly used, the application should be manifested with gdiScaling=True.
        ' This is different from either the dpiAwareness or dpiAware settings.
        ' The following is a manifest for doing that:
        '
        '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3" >
        ' ...
        '  <asmv3:application>
        '    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2017/WindowsSettings">
        '      <gdiScaling>true</gdiScaling>
        '    </asmv3:windowsSettings>
        '  </asmv3:application>
        ' ...
        '</assembly>
        '
        Dim iScale As Long
        Dim iRet As Long
        '
        If Not DllFunctionExists("shcore.dll", "GetScaleFactorForMonitor") Then
            MonitorScaleFactor = 1!
            Exit Function
        End If
        '
        iRet = GetScaleFactorForMonitor(hMonitor, iScale)
        If iRet <> 0 Then
            MonitorScaleFactor = 1!
            Exit Function
        End If
        '
        ' If we got to here, we've got a good scale factor.
        MonitorScaleFactor = CSng(iScale) / 100!
    End Function
    
    Public Function DllFunctionExists(ByVal sModule As String, ByVal sFunction As String) As Boolean
        ' This is for STANDARD DLLs.
        ' DllExists <--- just so we can find it.
        ' This can test for the existence of any DLL's function, no API declaration required.
        ' The caller may want to set a static for this test so that it's not called repeatedly.
        ' Finding DLLs is discussed here: https://msdn.microsoft.com/en-us/library/windows/desktop/ms682586(v=vs.85).aspx
        Dim hHandle As Long
        '
        hHandle = GetModuleHandleW(StrPtr(sModule))
        If hHandle = 0& Then
            hHandle = LoadLibraryExW(StrPtr(sModule), 0&, 0&)
            If hHandle <> 0& Then
                If GetProcAddress(hHandle, sFunction) <> 0& Then DllFunctionExists = True
            End If
        Else
            If GetProcAddress(hHandle, sFunction) <> 0& Then DllFunctionExists = True
        End If
        FreeLibrary hHandle
    End Function
    
    
    
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  11. #11
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Screen scaling issue....

    I understand what you are saying, you are not understanding what I am saying. If the OP wants the actual screen size or actual DPI, you are not going to get it with the code you posted:

    :: assume primary monitor for sake of argument for your hMonitorFromForm
    MonitorWidthPx(hMonitorForForm(Me)) * 15 = Screen.Width regardless of the DPI when app is not DPI aware.
    Screen.Width / Screen.TwipsPerPixel is not the actual screen width in any DPI other than 100%.

    OP wants the actual screen size

    Edited: I see you and I are now on the same page, regarding the OP's intent. However, manifest is not required to get actual screen size. I showed that in post #2
    Last edited by LaVolpe; May 5th, 2020 at 06:08 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  12. #12
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Screen scaling issue....

    I think we both posted at the same time. I think my post #10 brings us into agreement.

    EDIT: ezflyr, you may want to read what both LaVolpe and I said to fully understand the issue.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  13. #13
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: Screen scaling issue....

    is there a way to get the maximum (optimal) resolution that the display supports? (not the current setting, but the max resolution that the screen could be set to)?
    /Jimboat

  14. #14
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Screen scaling issue....

    Quote Originally Posted by Jimboat View Post
    is there a way to get the maximum (optimal) resolution that the display supports? (not the current setting, but the max resolution that the screen could be set to)?
    Posting this because by some small chance it may be useful to the OP. However, recommend starting a new thread with any questions related to this API vs potentially hijacking this thread for that reason.

    FYI: I've never used the API before and the declarations below came from API Viewer 2004. Review MSDN documentation for the API and the structure.
    Code:
    Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long
    Private Const CCHDEVICENAME As Long = 32
    Private Const CCHFORMNAME As Long = 32
    Private Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        dmSpecVersion As Integer
        dmDriverVersion As Integer
        dmSize As Integer
        dmDriverExtra As Integer
        dmFields As Long
        dmOrientation As Integer
        dmPaperSize As Integer
        dmPaperLength As Integer
        dmPaperWidth As Integer
        dmScale As Integer
        dmCopies As Integer
        dmDefaultSource As Integer
        dmPrintQuality As Integer
        dmColor As Integer
        dmDuplex As Integer
        dmYResolution As Integer
        dmTTOption As Integer
        dmCollate As Integer
        dmFormName As String * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
    End Type
    
    Private Sub Command1_Click()
    
        Dim DM As DEVMODE, n As Long
        EnumDisplaySettings vbNullString, n, DM
        Do
            n = n + 1
            If EnumDisplaySettings(vbNullString, n, DM) = 0 Then Exit Do
            Debug.Print n, DM.dmPelsWidth; DM.dmPelsHeight; DM.dmBitsPerPel; DM.dmDisplayFrequency
        Loop
    
    End Sub
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width