90 lines
3.4 KiB
VB.net
90 lines
3.4 KiB
VB.net
Imports System.Drawing
|
|
Imports System.Runtime.InteropServices
|
|
Imports System.Windows.Forms
|
|
Imports Microsoft.Win32
|
|
|
|
Public Class Screen
|
|
Public Function GetScreenScaling(Form As Form) As Single
|
|
Dim oHandle As IntPtr = Form.Handle
|
|
Dim oFactor1, oFactor2 As Single
|
|
|
|
oFactor1 = GetFactorFromDeviceCaps(oHandle)
|
|
oFactor2 = GetDPIFromMonitor(oHandle)
|
|
|
|
If oFactor1 > 1 Then
|
|
Return oFactor1
|
|
Else
|
|
Return oFactor2
|
|
End If
|
|
End Function
|
|
|
|
' =============================================================================================================
|
|
' === DEVICE CAPS
|
|
' =============================================================================================================
|
|
|
|
<DllImport("gdi32.dll")>
|
|
Friend Shared Function GetDeviceCaps(ByVal hdc As IntPtr, ByVal nIndex As Integer) As Integer
|
|
End Function
|
|
|
|
Public Enum DeviceCap
|
|
VERTRES = 10
|
|
DESKTOPVERTRES = 117
|
|
End Enum
|
|
|
|
Private Function GetFactorFromDeviceCaps(Handle As IntPtr) As Single
|
|
Dim g As Graphics = Graphics.FromHwnd(Handle)
|
|
Dim desktop As IntPtr = g.GetHdc()
|
|
Dim LogicalScreenHeight As Integer = GetDeviceCaps(desktop, CInt(DeviceCap.VERTRES))
|
|
Dim PhysicalScreenHeight As Integer = GetDeviceCaps(desktop, CInt(DeviceCap.DESKTOPVERTRES))
|
|
Dim oScreenScalingFactor As Single = CSng(PhysicalScreenHeight) / CSng(LogicalScreenHeight)
|
|
Return oScreenScalingFactor
|
|
End Function
|
|
|
|
' =============================================================================================================
|
|
' === MONITOR FROM WINDOW
|
|
' =============================================================================================================
|
|
|
|
'In W32 class
|
|
<DllImport("User32.dll", SetLastError:=True)>
|
|
Friend Shared Function MonitorFromWindow(ByVal hwnd As IntPtr,
|
|
ByVal dwFlags As Integer) As IntPtr
|
|
End Function
|
|
|
|
Friend Const MONITORINFOF_PRIMARY As Integer = &H1
|
|
Friend Const MONITOR_DEFAULTTONEAREST As Integer = &H2
|
|
Friend Const MONITOR_DEFAULTTONULL As Integer = &H0
|
|
Friend Const MONITOR_DEFAULTTOPRIMARY As Integer = &H1
|
|
|
|
<DllImport("Shcore.dll", SetLastError:=True)>
|
|
Friend Shared Function GetDpiForMonitor(ByVal hmonitor As IntPtr,
|
|
ByVal dpiType As Monitor_DPI_Type,
|
|
ByRef dpiX As UInteger,
|
|
ByRef dpiY As UInteger) As Integer
|
|
End Function
|
|
|
|
Friend Enum Monitor_DPI_Type As Integer
|
|
MDT_Effective_DPI = 0
|
|
MDT_Angular_DPI = 1
|
|
MDT_Raw_DPI = 2
|
|
MDT_Default = MDT_Effective_DPI
|
|
End Enum
|
|
|
|
Private Function GetDPIFromMonitor(Handle As IntPtr) As Single
|
|
'Get handle to monitor that contains this window.
|
|
Dim monitorHandle As IntPtr = MonitorFromWindow(Handle, MONITOR_DEFAULTTONEAREST)
|
|
|
|
'Get DPI (If the OS is not Windows 8.1 or newer, calling GetDpiForMonitor will cause exception).
|
|
Dim dpiX As UInteger
|
|
Dim dpiY As UInteger
|
|
|
|
Dim result As Integer = GetDpiForMonitor(monitorHandle, Monitor_DPI_Type.MDT_Default, dpiX, dpiY)
|
|
|
|
|
|
If (result = 0) Then 'If S_OK (= 0)
|
|
Return dpiX / 96.0F
|
|
Else
|
|
Return -1
|
|
End If
|
|
End Function
|
|
End Class
|