#FEATURE by Stefan Reise
class: WinWorkstation
class definition
class: WinWorkstation class
added:
#currentDisplayResolution
#currentDisplayResolutionBinary
#displayResolutionFromTool:
#displayScaleFactor
#virtualDisplayResolution
#virtualDisplayResolutionBinary
removed:
#nativeDisplayResolution
#primNativeDisplayResolution
#scaleFactorByUser
changed: #scaleFactorForRootDisplayCoordinates
--- 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'!