WinWorkstation.st
changeset 8861 0471653a6a2d
parent 8768 b6d390b45b83
child 8862 01f3bcebcd5c
--- 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'!