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 [
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

View File

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

View File

@ -210,7 +210,10 @@ CONSTANT: WM_NCMOUSELEAVE 0x02A2
CONSTANT: WM_WTSSESSION_CHANGE 0x02B1
CONSTANT: WM_TABLET_FIRST 0x02c0
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_COPY 0x0301
CONSTANT: WM_PASTE 0x0302

View File

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

View File

@ -1,10 +1,10 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays classes.struct fry kernel
literals locals make math math.bitwise multiline sequences
slots.syntax ui.backend.windows vocabs.loader windows.errors
windows.gdi32 windows.kernel32 windows.types windows.user32
ui.gadgets.worlds ;
USING: accessors alien.c-types alien.data classes.struct
io.binary kernel literals locals make math math.bitwise
sequences slots.syntax ui.backend.windows ui.gadgets.worlds
windows.errors windows.gdi32 windows.shcore windows.types
windows.user32 ;
IN: windows.fullscreen
: hwnd>hmonitor ( HWND -- HMONITOR )
@ -140,3 +140,7 @@ ERROR: unsupported-resolution triple ;
: set-fullscreen ( gadget triple 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> ;