-
May 5th, 2020, 02:09 PM
#1
Thread Starter
Member
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
-
May 5th, 2020, 02:19 PM
#2
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
-
May 5th, 2020, 03:13 PM
#3
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.
-
May 5th, 2020, 03:30 PM
#4
Thread Starter
Member
Re: Screen scaling issue....
Hi All,
OK, thanks for the replies! These suggestions look exactly like what I'm after!
Much thanks!
Jack
-
May 5th, 2020, 04:33 PM
#5
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 !!
-
May 5th, 2020, 05:19 PM
#6
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:
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:
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.
-
May 5th, 2020, 05:26 PM
#7
Re: Screen scaling issue....
Originally Posted by Elroy
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..."
-
May 5th, 2020, 05:36 PM
#8
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:
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.
-
May 5th, 2020, 05:44 PM
#9
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.
-
May 5th, 2020, 05:52 PM
#10
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.
-
May 5th, 2020, 05:54 PM
#11
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.
-
May 5th, 2020, 05:55 PM
#12
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.
-
May 6th, 2020, 10:20 AM
#13
Addicted Member
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)?
-
May 6th, 2020, 10:42 AM
#14
Re: Screen scaling issue....
Originally Posted by Jimboat
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|