#FEATURE by Stefan Reise
authorsr
Tue, 19 Nov 2019 12:19:46 +0100
changeset 8871 62717b04953b
parent 8870 d0a74d18b207
child 8872 7d7024512b49
#FEATURE by Stefan Reise support for windows scaling class: WinWorkstation class added: #commonDisplayResolutionBinaryFromPackageSubPath:binaryBaseNameWithoutSuffix: comment/format in: #displayScaleFactor #scaleFactorForRootDisplayCoordinates changed: #currentDisplayResolution #currentDisplayResolutionBinary #displayResolutionFromTool: #virtualDisplayResolution #virtualDisplayResolutionBinary category of: #currentDisplayResolutionBinary #displayResolutionFromTool: #virtualDisplayResolution #virtualDisplayResolutionBinary
WinWorkstation.st
--- a/WinWorkstation.st	Tue Nov 19 12:18:24 2019 +0100
+++ b/WinWorkstation.st	Tue Nov 19 12:19:46 2019 +0100
@@ -22,7 +22,8 @@
 	classVariableNames:'BeepDuration NativeDialogs NativeFileDialogs NativeWidgets
 		NativeWidgetClassTable StandardColorValues IgnoreSysColorChanges
 		IgnoreFontChanges SystemColorValues CanEndSession
-		VerboseNativeDialogs'
+		VerboseNativeDialogs CurrentDisplayResolutionFromTool
+		VirtualDisplayResolutionFromTool'
 	poolDictionaries:''
 	category:'Interface-Graphics'
 !
@@ -6572,10 +6573,139 @@
 %}
 ! !
 
+!WinWorkstation class methodsFor:'private'!
+
+commonDisplayResolutionBinaryFromPackageSubPath:packageSubPath
+    binaryBaseNameWithoutSuffix:binaryBaseNameWithoutSuffix
+
+    "
+        Screen 
+            commonDisplayResolutionBinaryFromPackageSubPath:'currentDisplayResolution'
+            binaryBaseNameWithoutSuffix:'cdr'
+    "
+
+    |packageId directory|
+
+    packageId := 'stx:support/win32/', packageSubPath, '/bin'.
+    directory := Smalltalk packageDirectoryForPackageId:packageId.
+    directory isNil ifTrue:[
+        'package "', packageId, '" is missing"' errorPrintCR.
+        ^ nil
+    ].
+
+    ^ directory / (binaryBaseNameWithoutSuffix, '.exe')
+
+    "Created: / 19-11-2019 / 11:58:44 / Stefan Reise"
+!
+
+currentDisplayResolutionBinary
+    "
+        Screen currentDisplayResolutionBinary        
+    "
+
+    ^ self 
+        commonDisplayResolutionBinaryFromPackageSubPath:'currentDisplayResolution'
+        binaryBaseNameWithoutSuffix:'cdr'
+
+    "Created: / 15-11-2019 / 09:32:22 / Stefan Reise"
+    "Modified (comment): / 19-11-2019 / 11:59:34 / Stefan Reise"
+!
+
+displayResolutionFromTool:aFilenameOrNil
+    "
+        self displayResolutionFromTool:self currentDisplayResolutionBinary         
+        self displayResolutionFromTool:self virtualDisplayResolutionBinary     
+    "
+
+    |output pointValues|
+
+    aFilenameOrNil isNil ifTrue:[
+        ^ nil 
+    ].                            
+    aFilenameOrNil exists ifFalse:[
+        'tool binary "', aFilenameOrNil nameString, '" is missing"' errorPrintCR.
+        ^ nil
+    ].
+
+    output := '' writeStream.   
+
+    OperatingSystem
+        executeCommand:aFilenameOrNil 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"
+    "Modified: / 19-11-2019 / 12:03:00 / Stefan Reise"
+!
+
+virtualDisplayResolution
+    "ATTENTION: can return nil if the package or the tool is missing:
+     stx:support/win32/virtualDisplayResolution/bin/vdr.exe  
+
+     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"
+
+    "
+        VirtualDisplayResolutionFromTool := nil.
+        self virtualDisplayResolution
+    "    
+
+    |tmp|
+
+    VirtualDisplayResolutionFromTool isNil ifTrue:[
+        tmp := self displayResolutionFromTool:self virtualDisplayResolutionBinary.
+        tmp isNil ifTrue:[
+            "use 0 to indicate nil,
+             avoid recalling of #displayResolutionFromTool:"
+            VirtualDisplayResolutionFromTool := 0.
+        ] ifFalse:[
+            VirtualDisplayResolutionFromTool := tmp.
+        ].
+    ].
+
+    VirtualDisplayResolutionFromTool == 0 ifTrue:[
+        ^ nil
+    ].
+
+    ^ VirtualDisplayResolutionFromTool
+
+    "Created: / 15-11-2019 / 09:37:48 / Stefan Reise"
+    "Modified (format): / 19-11-2019 / 12:17:02 / Stefan Reise"
+!
+
+virtualDisplayResolutionBinary
+    "      
+        Screen virtualDisplayResolutionBinary   
+    "
+
+    ^ self 
+        commonDisplayResolutionBinaryFromPackageSubPath:'virtualDisplayResolution'
+        binaryBaseNameWithoutSuffix:'vdr'
+
+    "Created: / 15-11-2019 / 09:32:51 / Stefan Reise"
+    "Modified (comment): / 19-11-2019 / 11:59:52 / Stefan Reise"
+! !
+
 !WinWorkstation class methodsFor:'queries'!
 
 currentDisplayResolution
-    "this is the current resolution of the display,
+    "ATTENTION: can return nil if the package or the tool is missing:
+     stx:support/win32/currentDisplayResolution/bin/cdr.exe
+
+     this is the current resolution of the display,
      without any effect of scaling
 
      for e.g.
@@ -6588,61 +6718,39 @@
         virtual display resolution -> 1080p"         
 
     "
-        self currentDisplayResolution
+        CurrentDisplayResolutionFromTool := nil. 
+        self currentDisplayResolution            
     "    
 
-    ^ self displayResolutionFromTool:self currentDisplayResolutionBinary
+    |tmp|
+
+    CurrentDisplayResolutionFromTool isNil ifTrue:[
+        tmp := self displayResolutionFromTool:self currentDisplayResolutionBinary.
+        tmp isNil ifTrue:[
+            "use 0 to indicate nil,
+             avoid recalling of #displayResolutionFromTool:"
+            CurrentDisplayResolutionFromTool := 0.
+        ] ifFalse:[
+            CurrentDisplayResolutionFromTool := tmp.
+        ].
+    ].
+
+    CurrentDisplayResolutionFromTool == 0 ifTrue:[
+        ^ nil
+    ].
+
+    ^ CurrentDisplayResolutionFromTool
 
     "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.
-
-    aFilename exists ifFalse:[
-        'tool binary "', aFilename nameString, '" is missing"' errorPrintCR.
-        ^ nil
-    ].
-
-    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"
+    "Modified (comment): / 19-11-2019 / 12:17:27 / Stefan Reise"
 !
 
 displayScaleFactor
-    "this is the scale factor the user did enter within the windows settings,
+    "ATTENTION: returns the may wrong default 1@1 if the package or the tool is missing:
+     stx:support/win32/currrentDisplayResolution/bin/cdr.exe
+     stx:support/win32/virtualDisplayResolution/bin/vdr.exe
+
+     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"
 
@@ -6667,6 +6775,7 @@
     ^ currentDisplayResolution / virtualDisplayResolution
 
     "Created: / 15-11-2019 / 09:43:53 / Stefan Reise"
+    "Modified (comment): / 19-11-2019 / 12:07:55 / Stefan Reise"
 !
 
 isWindowsPlatform
@@ -6686,7 +6795,10 @@
 !
 
 scaleFactorForRootDisplayCoordinates
-    "this is the factor we need to adopt for the root display coordinates,
+    "ATTENTION: returns the may wrong default 1@1 (from super) if the package or the tool is missing:
+     stx:support/win32/currrentDisplayResolution/bin/cdr.exe
+
+     this is the factor we need to adopt for the root display coordinates,
      if windows did scale the application (when the app is not high DPI aware)"
 
     "
@@ -6704,47 +6816,7 @@
     ^ currentDisplayResolution / Display extent
 
     "Created: / 14-11-2019 / 13:36:59 / Stefan Reise"
-    "Modified (comment): / 15-11-2019 / 10:47:30 / 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"
+    "Modified (comment): / 19-11-2019 / 12:08:26 / Stefan Reise"
 ! !
 
 !WinWorkstation methodsFor:'accessing & queries'!