Windows: Properly calculate Screen scaling

GUIs.Test.TestGUI/TestGUI.vbproj

@@ -248,6 +248,10 @@
       <Project>{a8c3f298-76ab-4359-ab3c-986e313b4336}</Project>
       <Name>EDMIService</Name>
     </ProjectReference>
+    <ProjectReference Include="..\Windows\Windows.vbproj">
+      <Project>{5efaef9b-90b9-4f05-9f70-f79ad77fff86}</Project>
+      <Name>Windows</Name>
+    </ProjectReference>
   </ItemGroup>
   <ItemGroup>
     <None Include="Resources\alignhorizontalbottom.svg" />

GUIs.Test.TestGUI/frmStart.Designer.vb

@@ -25,6 +25,7 @@ Partial Class frmStart
         Me.Button1 = New System.Windows.Forms.Button()
         Me.Button2 = New System.Windows.Forms.Button()
         Me.Button3 = New System.Windows.Forms.Button()
+        Me.Button4 = New System.Windows.Forms.Button()
         Me.SuspendLayout()
         '
         'Button1
@@ -54,11 +55,21 @@ Partial Class frmStart
         Me.Button3.Text = "Filesystem"
         Me.Button3.UseVisualStyleBackColor = True
         '
+        'Button4
+        '
+        Me.Button4.Location = New System.Drawing.Point(12, 195)
+        Me.Button4.Name = "Button4"
+        Me.Button4.Size = New System.Drawing.Size(236, 59)
+        Me.Button4.TabIndex = 1
+        Me.Button4.Text = "Skalierungsfaktor"
+        Me.Button4.UseVisualStyleBackColor = True
+        '
         'frmStart
         '
         Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
         Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
         Me.ClientSize = New System.Drawing.Size(800, 450)
+        Me.Controls.Add(Me.Button4)
         Me.Controls.Add(Me.Button3)
         Me.Controls.Add(Me.Button2)
         Me.Controls.Add(Me.Button1)
@@ -71,4 +82,5 @@ Partial Class frmStart
     Friend WithEvents Button1 As Button
     Friend WithEvents Button2 As Button
     Friend WithEvents Button3 As Button
+    Friend WithEvents Button4 As Button
 End Class

GUIs.Test.TestGUI/frmStart.vb

@@ -1,4 +1,6 @@
-Public Class frmStart
+Imports Microsoft.Win32
+
+Public Class frmStart
     Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
         frmRelations.Show()
     End Sub
@@ -10,4 +12,10 @@
     Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
         frmFilesystem.Show()
     End Sub
+
+    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
+        Dim oScreen As New DigitalData.Modules.Windows.Screen()
+
+        MsgBox("Scaling: " & oScreen.GetScreenScaling(Me))
+    End Sub
 End Class

Windows/Screen.vb

@@ -1,9 +1,29 @@
 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")>
-    Private Shared Function GetDeviceCaps(ByVal hdc As IntPtr, ByVal nIndex As Integer) As Integer
+    Friend Shared Function GetDeviceCaps(ByVal hdc As IntPtr, ByVal nIndex As Integer) As Integer
     End Function
 
     Public Enum DeviceCap
@@ -11,12 +31,59 @@ Public Class Screen
         DESKTOPVERTRES = 117
     End Enum
 
-    Public Shared Function GetScalingFactor() As Single
+    Private Function GetFactorFromDeviceCaps(Handle As IntPtr) As Single
-        Dim g As Graphics = Graphics.FromHwnd(IntPtr.Zero)
+        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 ScreenScalingFactor As Single = CSng(PhysicalScreenHeight) / CSng(LogicalScreenHeight)
+        Dim oScreenScalingFactor As Single = CSng(PhysicalScreenHeight) / CSng(LogicalScreenHeight)
-        Return ScreenScalingFactor
+        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

Windows/Windows.vbproj

@@ -47,6 +47,7 @@
     <Reference Include="NLog, Version=4.0.0.0, Culture=neutral, PublicKeyToken=5120e14c03d0593c, processorArchitecture=MSIL">
       <HintPath>..\packages\NLog.4.7.5\lib\net45\NLog.dll</HintPath>
     </Reference>
+    <Reference Include="PresentationCore" />
     <Reference Include="System" />
     <Reference Include="System.Configuration" />
     <Reference Include="System.Data" />
@@ -61,6 +62,7 @@
     <Reference Include="System.Xml.Linq" />
     <Reference Include="System.Data.DataSetExtensions" />
     <Reference Include="System.Net.Http" />
+    <Reference Include="WindowsBase" />
   </ItemGroup>
   <ItemGroup>
     <Import Include="Microsoft.VisualBasic" />