chubbychub, I can't quite understand where you want to display the Userform on the screen. From the attached image in post #9, you can see that you want to place the Userform near the bottom edge. In post #12 you are combining to make the Userform appear in different places on the screen, depending on the scale you read.
The rest of my post is about placing the Userform close to the bottom edge of the screen. With such an assumption, knowing the scale seems unnecessary. It is enough to read the displayed resolution (it is expressed in px), convert this to points (pt) and display the form in the appropriate place. The following code displays the form near the bottom edge of the screen regardless of the resolution and scale used
Option Explicit
Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const LOGPIXELSX = 88 'px/logical inch
Private Const POINTS_PER_INCH As Long = 72 '1pt=1/72 inch
Sub ShowForm()
Dim ScrWidth As Single 'in pt
Dim ScrHeight As Single 'in pt
Dim PpP As Single
Dim X As Long 'in px
Dim Y As Long 'in px
PpP = PointsPerPixel
Call ScreenRes(X, Y)
ScrWidth = X * PpP ' in pt
ScrHeight = Y * PpP 'in pt
With UserForm1
.StartUpPosition = 0
.Top = ScrHeight - .Height - 20 ' in pt
.Left = (ScrWidth - .Width) / 2 ' in pt
.Show 'vbModeless
End With
End Sub
Function ScreenRes(X As Long, Y As Long) As String
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
ScreenRes = X & " x " & Y
End Function
Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
About the scale.
On mine (Win 10), the GetDpi function, or more precisely the winAPI GetDeviceCaps function, always returns 96 regardless of the scale set. This may have made sense in the past (below Win 8). I can't check on an 8.1 system (because I don't have it anymore), but the function below should return a DPI that depends on the scale used. Unfortunately, it doesn't work properly in Win 10.
Option Explicit
'Probably only Win 8.1 - not tested!
Private Declare PtrSafe Function GetDpiForMonitor Lib "shcore.dll" _
(ByVal hMonitor As LongPtr, _
ByVal dpiType As Long, _
ByRef dpiX As Long, _
ByRef dpiY As Long) As Long
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" _
(ByVal hwnd As LongPtr, _
ByVal dwFlags As Long) As Long
Sub TestScale()
MsgBox GetWinScale(GetMonitorDPI) & " %"
End Sub
Function GetMonitorDPI() As Long
Dim hMonitor As LongPtr
Dim dpiX As Long
Dim dpiY As Long
hMonitor = MonitorFromWindow(Application.hwnd, &H2)
GetDpiForMonitor hMonitor, 0, dpiX, dpiY
GetMonitorDPI = dpiX
End Function
Function GetWinScale(DPI As Long) As Long
GetWinScale = 100 * DPI / 96
End Function
For Win 10:
Option Explicit
'Only Win 10 or greater
Private Declare PtrSafe Function GetDpiForWindow Lib "user32.dll" _
(ByVal hwnd As LongPtr) As Long
Sub TestScale()
MsgBox GetWinScale(GetMonitorDPI) & " %"
End Sub
Function GetMonitorDPI() As Long
GetMonitorDPI = GetDpiForWindow(Application.hwnd)
End Function
Function GetWinScale(DPI As Long) As Long
GetWinScale = 100 * DPI / 96
End Function
For now, I think that for the purpose of the OP task, knowledge of scale is not needed.
Artik
Reply With Quote
