windows: Fix user32/shcore DPI functions.

master
Doug Coleman 2020-03-09 19:39:32 -05:00
parent 67d5e633f1
commit 96d3482475
6 changed files with 112 additions and 27 deletions

View File

@ -533,6 +533,9 @@ SYMBOL: wm-handlers
wm-handlers [ wm-handlers [
H{ H{
${ WM_CLOSE [ handle-wm-close 0 ] } ${ 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_PAINT [ 4dup handle-wm-paint DefWindowProc ] }
${ WM_SIZE [ handle-wm-size 0 ] } ${ WM_SIZE [ handle-wm-size 0 ] }
@ -603,6 +606,7 @@ M: windows-ui-backend do-events
] [ drop ] if ; ] [ drop ] if ;
: adjust-RECT ( RECT style ex-style -- ) : adjust-RECT ( RECT style ex-style -- )
! [ 0 ] dip GetDpiForSystem AdjustWindowRectExForDpi win32-error=0/f ;
[ 0 ] dip AdjustWindowRectEx win32-error=0/f ; [ 0 ] dip AdjustWindowRectEx win32-error=0/f ;
: make-RECT ( world -- RECT ) : make-RECT ( world -- RECT )
@ -630,6 +634,14 @@ M: windows-ui-backend do-events
dup dup
] change-global ; ] 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 ) :: create-window ( rect style ex-style -- hwnd )
rect style ex-style make-adjusted-RECT rect style ex-style make-adjusted-RECT
[ get-window-class f ] dip [ get-window-class f ] dip

View File

@ -1640,7 +1640,7 @@ FUNCTION: BOOL GdiFlush ( )
! FUNCTION: GetDCBrushColor ! FUNCTION: GetDCBrushColor
! FUNCTION: GetDCOrgEx ! FUNCTION: GetDCOrgEx
! FUNCTION: GetDCPenColor ! FUNCTION: GetDCPenColor
! FUNCTION: GetDeviceCaps FUNCTION: int GetDeviceCaps ( HDC hdc, int index )
! FUNCTION: GetDeviceGammaRamp ! FUNCTION: GetDeviceGammaRamp
! FUNCTION: GetDIBColorTable ! FUNCTION: GetDIBColorTable
! FUNCTION: GetDIBits ! FUNCTION: GetDIBits

View File

@ -210,7 +210,10 @@ CONSTANT: WM_NCMOUSELEAVE 0x02A2
CONSTANT: WM_WTSSESSION_CHANGE 0x02B1 CONSTANT: WM_WTSSESSION_CHANGE 0x02B1
CONSTANT: WM_TABLET_FIRST 0x02c0 CONSTANT: WM_TABLET_FIRST 0x02c0
CONSTANT: WM_TABLET_LAST 0x02df CONSTANT: WM_TABLET_LAST 0x02df
CONSTANT: WM_DPICHANGED 0x02E0 CONSTANT: WM_DPICHANGED 0x02e0
CONSTANT: WM_DPICHANGED_BEFOREPARENT 0x02e2
CONSTANT: WM_DPICHANGED_AFTERPARENT 0x02e3
CONSTANT: WM_GETDPISCALEDSIZE 0x2e4
CONSTANT: WM_CUT 0x0300 CONSTANT: WM_CUT 0x0300
CONSTANT: WM_COPY 0x0301 CONSTANT: WM_COPY 0x0301
CONSTANT: WM_PASTE 0x0302 CONSTANT: WM_PASTE 0x0302

View File

@ -11,4 +11,65 @@ ENUM: MONITOR_DPI_TYPE
MDT_RAW_DPI MDT_RAW_DPI
{ MDT_DEFAULT 0 } ; { MDT_DEFAULT 0 } ;
ENUM: PROCESS_DPI_AWARENESS
{ PROCESS_DPI_UNAWARE 0 }
{ PROCESS_SYSTEM_DPI_AWARE 1 }
{ PROCESS_PER_MONITOR_DPI_AWARE 2 } ;
ENUM: SCALE_CHANGE_FLAGS
{ SCF_VALUE_NONE 0 }
{ SCF_SCALE 1 }
{ SCF_PHYSICAL 2 } ;
FUNCTION: HRESULT GetDpiForMonitor ( HMONITOR hMonitor, MONITOR_DPI_TYPE dpiType, UINT* dpiX, UINT *dpiY ) FUNCTION: HRESULT GetDpiForMonitor ( HMONITOR hMonitor, MONITOR_DPI_TYPE dpiType, UINT* dpiX, UINT *dpiY )
ENUM: DEVICE_SCALE_FACTOR
{ DEVICE_SCALE_FACTOR_INVALID 0 }
{ SCALE_100_PERCENT 100 }
{ SCALE_120_PERCENT 120 }
{ SCALE_125_PERCENT 125 }
{ SCALE_140_PERCENT 140 }
{ SCALE_150_PERCENT 150 }
{ SCALE_160_PERCENT 160 }
{ SCALE_175_PERCENT 175 }
{ SCALE_180_PERCENT 180 }
{ SCALE_200_PERCENT 200 }
{ SCALE_225_PERCENT 223 }
{ SCALE_250_PERCENT 250 }
{ SCALE_300_PERCENT 300 }
{ SCALE_350_PERCENT 350 }
{ SCALE_400_PERCENT 400 }
{ SCALE_450_PERCENT 450 }
{ SCALE_500_PERCENT 500 } ;
FUNCTION: HRESULT GetScaleFactorForMonitor (
HMONITOR hMon,
DEVICE_SCALE_FACTOR *pScale
)
FUNCTION: HRESULT RegisterScaleChangeEvent (
HANDLE hEvent,
DWORD_PTR *pdwCookie
)
ENUM: DISPLAY_DEVICE_TYPE
{ DEVICE_PRIMARY 0 }
{ DEVICE_IMMERSIVE 1 } ;
FUNCTION: HRESULT RevokeScaleChangeNotifications (
DISPLAY_DEVICE_TYPE displayDevice,
DWORD dwCookie
)
FUNCTION: HRESULT UnregisterScaleChangeEvent (
DWORD_PTR dwCookie
)
FUNCTION: HRESULT GetProcessDpiAwareness ( HANDLE hprocess, PROCESS_DPI_AWARENESS* value )
FUNCTION: HRESULT SetProcessDpiAwareness ( PROCESS_DPI_AWARENESS value )
ENUM: SHELL_UI_COMPONENT
{ SHELL_UI_COMPONENT_TASKBARS 0 }
{ SHELL_UI_COMPONENT_NOTIFICATIONAREA 1 }
{ SHELL_UI_COMPONENT_DESKBAND 2 } ;

View File

@ -2263,11 +2263,6 @@ STRUCT: POWERBROADCAST_SETTING
! HighDPI ! HighDPI
TYPEDEF: HANDLE DPI_AWARENESS_CONTEXT TYPEDEF: HANDLE DPI_AWARENESS_CONTEXT
ENUM: PROCESS_DPI_AWARENESS
{ PROCESS_DPI_UNAWARE 0 }
{ PROCESS_SYSTEM_DPI_AWARE 1 }
{ PROCESS_PER_MONITOR_DPI_AWARE 2 } ;
ENUM: DPI_AWARENESS ENUM: DPI_AWARENESS
{ DPI_AWARENESS_INVALID -1 } { DPI_AWARENESS_INVALID -1 }
{ DPI_AWARENESS_UNAWARE 0 } { DPI_AWARENESS_UNAWARE 0 }
@ -2314,8 +2309,6 @@ FUNCTION: UINT GetDpiForSystem ( )
FUNCTION: UINT GetDpiForWindow ( HWND hwnd ) FUNCTION: UINT GetDpiForWindow ( HWND hwnd )
FUNCTION: HRESULT GetProcessDpiAwareness ( HANDLE hprocess, PROCESS_DPI_AWARENESS* value )
FUNCTION: UINT GetSystemDpiForProcess ( FUNCTION: UINT GetSystemDpiForProcess (
HANDLE hProcess HANDLE hProcess
) )
@ -2340,28 +2333,40 @@ FUNCTION: DPI_HOSTING_BEHAVIOR GetWindowDpiHostingBehavior (
) )
FUNCTION: BOOL SetProcessDPIAware ( ) FUNCTION: BOOL SetProcessDPIAware ( )
FUNCTION: HRESULT SetProcessDpiAwareness ( PROCESS_DPI_AWARENESS value )
FUNCTION: BOOL SetProcessDpiAwarenessContext ( DPI_AWARENESS_CONTEXT value ) FUNCTION: BOOL SetProcessDpiAwarenessContext ( DPI_AWARENESS_CONTEXT value )
FUNCTION: DPI_AWARENESS_CONTEXT GetWindowDpiAwarenessContext ( HWND hwnd ) FUNCTION: DPI_AWARENESS_CONTEXT GetWindowDpiAwarenessContext ( HWND hwnd )
FUNCTION: DPI_AWARENESS GetAwarenessFromDpiAwarenessContext ( DPI_AWARENESS_CONTEXT value ) FUNCTION: DPI_AWARENESS GetAwarenessFromDpiAwarenessContext ( DPI_AWARENESS_CONTEXT value )
: get-thread-dpi-awareness ( -- enum )
GetThreadDpiAwarenessContext GetAwarenessFromDpiAwarenessContext ;
FUNCTION: BOOL IsValidDpiAwarenessContext ( FUNCTION: BOOL IsValidDpiAwarenessContext (
DPI_AWARENESS_CONTEXT value DPI_AWARENESS_CONTEXT value
) )
! Needs work ! DPI_AWARENESS_CONTEXT experimentally:
! GetThreadDpiAwarenessContext -8 swap <displaced-alien> IsValidDpiAwarenessContext ! 0, should be 1 ! USE: math.ranges -100 1000 [a,b] [ <alien> IsValidDpiAwarenessContext ] map-zip
! : DPI_AWARENESS_CONTEXT_UNAWARE ( -- DPI_AWARENESS_CONTEXT ) ! [ nip 0 > ] assoc-filter keys .
! GetThreadDpiAwarenessContext -1 swap <displaced-alien> ; ! { -5 -4 -3 -2 -1 17 18 34 273 529 785 }
! : DPI_AWARENESS_CONTEXT_SYSTEM_AWARE ( -- DPI_AWARENESS_CONTEXT )
! GetThreadDpiAwarenessContext -2 swap <displaced-alien> ; ! -4 <alien> 34 <alien> AreDpiAwarenessContextsEqual . ! t
! : DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE ( -- DPI_AWARENESS_CONTEXT ) ! -5 <alien> -5 <alien> AreDpiAwarenessContextsEqual . ! t
! GetThreadDpiAwarenessContext -3 swap <displaced-alien> ; ! -6 <alien> -6 <alien> AreDpiAwarenessContextsEqual . ! f
! : DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ( -- DPI_AWARENESS_CONTEXT ) : DPI_AWARENESS_CONTEXT_UNAWARE ( -- DPI_AWARENESS_CONTEXT )
! GetThreadDpiAwarenessContext -4 swap <displaced-alien> ; -1 <alien> ;
! : DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED ( -- DPI_AWARENESS_CONTEXT )
! GetThreadDpiAwarenessContext -5 swap <displaced-alien> ; : DPI_AWARENESS_CONTEXT_SYSTEM_AWARE ( -- DPI_AWARENESS_CONTEXT )
-2 <alien> ;
: DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE ( -- DPI_AWARENESS_CONTEXT )
-3 <alien> ;
: DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ( -- DPI_AWARENESS_CONTEXT )
-4 <alien> ;
: DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED ( -- DPI_AWARENESS_CONTEXT )
-5 <alien> ;
FUNCTION: BOOL LogicalToPhysicalPointForPerMonitorDPI ( FUNCTION: BOOL LogicalToPhysicalPointForPerMonitorDPI (
HWND hWnd, HWND hWnd,

View File

@ -1,10 +1,10 @@
! Copyright (C) 2010 Doug Coleman. ! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays classes.struct fry kernel USING: accessors alien.c-types alien.data classes.struct
literals locals make math math.bitwise multiline sequences io.binary kernel literals locals make math math.bitwise
slots.syntax ui.backend.windows vocabs.loader windows.errors sequences slots.syntax ui.backend.windows ui.gadgets.worlds
windows.gdi32 windows.kernel32 windows.types windows.user32 windows.errors windows.gdi32 windows.shcore windows.types
ui.gadgets.worlds ; windows.user32 ;
IN: windows.fullscreen IN: windows.fullscreen
: hwnd>hmonitor ( HWND -- HMONITOR ) : hwnd>hmonitor ( HWND -- HMONITOR )
@ -140,3 +140,7 @@ ERROR: unsupported-resolution triple ;
: set-fullscreen ( gadget triple fullscreen? -- ) : set-fullscreen ( gadget triple fullscreen? -- )
[ find-world ] 2dip (set-fullscreen) ; [ find-world ] 2dip (set-fullscreen) ;
: get-desktop-scale-factor ( -- n )
desktop-hmonitor 0 DEVICE_SCALE_FACTOR <ref>
[ GetScaleFactorForMonitor win32-error=0/f ] keep le> ;