windows: Fix user32/shcore DPI functions.

[factor.git] / basis / ui / backend / windows / windows.factor

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 8ce6463dab0f8acea5d688db2cdea5bd995fc1d9..0982ae37704214c4a54d6d9636725edfe6d7009f 100644 (file)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -533,6 +533,9 @@ SYMBOL: wm-handlers
 wm-handlers [
     H{
         ${ WM_CLOSE [ handle-wm-close 0 ] }
+        ! ${ WM_NCCREATE [ [ 3drop EnableNonClientDpiScaling drop ] [ DefWindowProc ] 4bi ] }
+        ! ${ WM_GETDPISCALEDSIZE [ DefWindowProc ] }
+        ! ${ WM_DPICHANGED [ DefWindowProc ] }
         ${ WM_PAINT [ 4dup handle-wm-paint DefWindowProc ] }
 
         ${ WM_SIZE [ handle-wm-size 0 ] }
@@ -603,6 +606,7 @@ M: windows-ui-backend do-events
     ] [ drop ] if ;
 
 : adjust-RECT ( RECT style ex-style -- )
+    ! [ 0 ] dip GetDpiForSystem AdjustWindowRectExForDpi win32-error=0/f ;
     [ 0 ] dip AdjustWindowRectEx win32-error=0/f ;
 
 : make-RECT ( world -- RECT )
@@ -630,6 +634,14 @@ M: windows-ui-backend do-events
         dup
     ] change-global ;
 
+: get-device-caps ( handle -- x y )
+    GetDC
+    [ LOGPIXELSX GetDeviceCaps ]
+    [ LOGPIXELSY GetDeviceCaps ] bi ;
+
+: get-default-device-caps ( -- x y )
+    f get-device-caps ;
+
 :: create-window ( rect style ex-style -- hwnd )
     rect style ex-style make-adjusted-RECT
     [ get-window-class f ] dip