#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
--- 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'!