--- a/WinWorkstation.st Thu Nov 14 13:46:37 2019 +0100
+++ b/WinWorkstation.st Thu Nov 14 14:06:23 2019 +0100
@@ -22,7 +22,7 @@
classVariableNames:'BeepDuration NativeDialogs NativeFileDialogs NativeWidgets
NativeWidgetClassTable StandardColorValues IgnoreSysColorChanges
IgnoreFontChanges SystemColorValues CanEndSession
- VerboseNativeDialogs'
+ VerboseNativeDialogs ScaleFactorByUser NativeDisplayResolution'
poolDictionaries:''
category:'Interface-Graphics'
!
@@ -6580,6 +6580,37 @@
^ true
!
+nativeDisplayResolution
+ "the powershell call is too expensive,
+ so cache it, you need to restart the app,
+ when you want to get an effect of changed display"
+
+ "
+ self nativeDisplayResolution
+ "
+
+ |primNativeDisplayResolution|
+
+ NativeDisplayResolution isNil ifTrue:[
+ primNativeDisplayResolution := self primNativeDisplayResolution.
+ primNativeDisplayResolution isNil ifTrue:[
+ "/ set 0 to avoid multiple calls of #primNativeDisplayResolution
+ NativeDisplayResolution := 0.
+ ] ifFalse:[
+ NativeDisplayResolution := primNativeDisplayResolution.
+ ].
+ ].
+
+ "0 is the ident for nil"
+ NativeDisplayResolution == 0 ifTrue:[
+ ^ nil
+ ].
+
+ ^ NativeDisplayResolution
+
+ "Created: / 14-11-2019 / 13:36:08 / Stefan Reise"
+!
+
platformName
"ST-80 compatibility.
Return a string describing the display systems platform.
@@ -6588,6 +6619,137 @@
^ 'WIN32'
"Modified: 26.5.1996 / 15:32:46 / cg"
+!
+
+primNativeDisplayResolution
+ "
+ self primNativeDisplayResolution
+ "
+
+ |output modeLine tmpString dataAsString
+ x y|
+
+ output := '' writeStream.
+
+ OperatingSystem
+ executePowershellCommands:(Array
+ with:'Get-CimInstance -ClassName CIM_VideoController')
+ outputTo:output.
+
+ modeLine := (output contents
+ subStrings:Character cr)
+ detect:[:eachLine | eachLine startsWith:'VideoModeDescription']
+ ifNone:[
+ ^ nil
+ ].
+
+ tmpString := (modeLine
+ subStrings:$:)
+ at:2
+ ifAbsent:[
+ ^ nil
+ ].
+
+ dataAsString := (tmpString
+ subStrings:$x)
+ collect:[:each |
+ each withoutSeparators
+ ].
+
+ x := dataAsString
+ at:1
+ ifAbsent:[
+ ^ nil
+ ].
+
+ x := Integer
+ readFrom:x
+ onError:[
+ ^ nil
+ ].
+
+ y := dataAsString
+ at:2
+ ifAbsent:[
+ ^ nil
+ ].
+
+ y := Integer
+ readFrom:y
+ onError:[
+ ^ nil
+ ].
+
+ ^ x@y
+
+ "Created: / 14-11-2019 / 13:35:59 / Stefan Reise"
+!
+
+scaleFactorByUser
+ "this is the scale factor the user did enter within the windows settings,
+ for e.g. the user can choose between 100, 125, 150 etc.
+ here we return 1, 1.25 1.5
+ the call is too expensive (powershell),
+ so cache it, you need to restart the app,
+ when you want to get an effect of changed scaling"
+
+ "
+ ScaleFactorByUser := nil.
+ self scaleFactorByUser
+ "
+
+ |output scaledDesktopResolution|
+
+ ScaleFactorByUser isNil ifTrue:[
+ output := '' writeStream.
+
+ OperatingSystem
+ executePowershellCommands:(Array
+ with:'[void][Reflection.Assembly]::LoadWithPartialName("System.Windows.Forms");'
+ with:'$ScreenExtent = [System.Windows.Forms.SystemInformation]::PrimaryMonitorSize;'
+ with:'$Width = $ScreenExtent.Width;'
+ with:'$Height = $ScreenExtent.Height;'
+ with:'Write-Output "$Width@$Height";')
+ outputTo:output.
+
+ scaledDesktopResolution := Point
+ readFrom:output contents withoutSeparators
+ onError:nil.
+
+ scaledDesktopResolution isNil ifTrue:[
+ ScaleFactorByUser := 1@1.
+ ] ifFalse:[
+ ScaleFactorByUser := Display extent / scaledDesktopResolution.
+ ].
+ ].
+
+ ^ ScaleFactorByUser
+
+ "Created: / 14-11-2019 / 13:25:46 / Stefan Reise"
+!
+
+scaleFactorForRootDisplayCoordinates
+ "this is the factor we need to adopt for the root display coordinates,
+ if windows did scale the application"
+
+ "
+ self scaleFactorForRootDisplayCoordinates
+ "
+
+ |nativeDisplayResolution|
+
+ "here we assume the user has the native resolution with a scaling,
+ sorry no support for non native resolutions,
+ because I did not found any mechanism,
+ which did return the user specified resolution without any scaling"
+ nativeDisplayResolution := self nativeDisplayResolution.
+ nativeDisplayResolution isNil ifTrue:[
+ ^ 1@1
+ ].
+
+ ^ nativeDisplayResolution / Display extent
+
+ "Created: / 14-11-2019 / 13:36:59 / Stefan Reise"
! !
!WinWorkstation methodsFor:'accessing & queries'!