#FEATURE by Stefan Reise
authorsr
Fri, 15 Nov 2019 09:45:40 +0100
changeset 8863 3552fb896324
parent 8862 01f3bcebcd5c
child 8864 4ef7f3f274ef
#FEATURE by Stefan Reise class: WinWorkstation class definition class: WinWorkstation class added: #currentDisplayResolution #currentDisplayResolutionBinary #displayResolutionFromTool: #displayScaleFactor #virtualDisplayResolution #virtualDisplayResolutionBinary removed: #nativeDisplayResolution #primNativeDisplayResolution #scaleFactorByUser changed: #scaleFactorForRootDisplayCoordinates
WinWorkstation.st
--- a/WinWorkstation.st	Thu Nov 14 14:27:09 2019 +0100
+++ b/WinWorkstation.st	Fri Nov 15 09:45:40 2019 +0100
@@ -22,7 +22,7 @@
 	classVariableNames:'BeepDuration NativeDialogs NativeFileDialogs NativeWidgets
 		NativeWidgetClassTable StandardColorValues IgnoreSysColorChanges
 		IgnoreFontChanges SystemColorValues CanEndSession
-		VerboseNativeDialogs ScaleFactorByUser NativeDisplayResolution'
+		VerboseNativeDialogs'
 	poolDictionaries:''
 	category:'Interface-Graphics'
 !
@@ -6574,43 +6574,88 @@
 
 !WinWorkstation class methodsFor:'queries'!
 
+currentDisplayResolution
+    "this is the current resolution of the display,
+     without any effect of scaling
+
+     for e.g.
+        real current display resolution -> 1080p
+        scaling 150%
+        virtual display resolution -> 720p
+
+        real current display resolution -> 1080p
+        scaling 100%
+        virtual display resolution -> 1080p"         
+
+    "
+        self currentDisplayResolution
+    "    
+
+    ^ self displayResolutionFromTool:self currentDisplayResolutionBinary
+
+    "Created: / 15-11-2019 / 09:37:53 / Stefan Reise"
+!
+
+currentDisplayResolutionBinary
+    "
+        Screen currentDisplayResolutionBinary 
+    "
+
+    |packageId directory|
+
+    packageId := 'stx:support/win32/currentDisplayResolution/bin'.
+    directory := Smalltalk packageDirectoryForPackageId:packageId.
+    directory isNil ifTrue:[
+        ^ nil
+    ].
+
+    ^ directory / 'cdr.exe'
+
+    "Created: / 15-11-2019 / 09:32:22 / Stefan Reise"
+!
+
+displayResolutionFromTool:aFilename
+    "
+        self displayResolutionFromTool:self currentDisplayResolutionBinary    
+        self displayResolutionFromTool:self virtualDisplayResolutionBinary     
+    "
+
+    |output pointValues|
+
+    output := '' writeStream.
+
+    OperatingSystem
+        executeCommand:aFilename pathName
+        outputTo:output 
+        errorTo:output.
+
+    pointValues := output contents subStrings:$x.
+
+    ^ pointValues first asInteger@pointValues second asInteger
+
+    "Created: / 15-11-2019 / 09:37:01 / Stefan Reise"
+!
+
+displayScaleFactor
+    "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"
+
+    "
+        self displayScaleFactor          
+    "
+
+    ^ self currentDisplayResolution / self virtualDisplayResolution
+
+    "Created: / 15-11-2019 / 09:43:53 / Stefan Reise"
+!
+
 isWindowsPlatform
     "return true, if this device is a windows screen"
 
     ^ 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.
@@ -6621,137 +6666,54 @@
     "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
-     ATTENTION, this factor only takes effect when the app is DPI aware 
-     and a scaling has been set by the user"
-
-    "
-        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
+     if windows did scale the application (when the app is not high DPI aware"
+
+    ^ self currentDisplayResolution / Display extent
 
     "Created: / 14-11-2019 / 13:36:59 / Stefan Reise"
+    "Modified: / 15-11-2019 / 09:42:27 / Stefan Reise"
+!
+
+virtualDisplayResolution
+    "this is the resolution of a virtual display,
+     this resolution is effected by the scaling
+
+     for e.g.
+        real current display resolution -> 1080p
+        scaling 150%
+        virtual display resolution -> 720p
+
+        real current display resolution -> 1080p
+        scaling 100%
+        virtual display resolution -> 1080p"
+
+    "
+        self virtualDisplayResolution
+    "    
+
+    ^ self displayResolutionFromTool:self virtualDisplayResolutionBinary
+
+    "Created: / 15-11-2019 / 09:37:48 / Stefan Reise"
+!
+
+virtualDisplayResolutionBinary
+    "      
+        Screen virtualDisplayResolutionBinary 
+    "
+
+    |packageId directory|
+
+    packageId := 'stx:support/win32/virtualDisplayResolution/bin'.
+    directory := Smalltalk packageDirectoryForPackageId:packageId.
+    directory isNil ifTrue:[
+        ^ nil
+    ].
+
+    ^ directory / 'vdr.exe'
+
+    "Created: / 15-11-2019 / 09:32:51 / Stefan Reise"
 ! !
 
 !WinWorkstation methodsFor:'accessing & queries'!