--- a/WinWorkstation.st Fri Nov 22 15:19:34 2019 +0100
+++ b/WinWorkstation.st Fri Nov 22 15:20:48 2019 +0100
@@ -22,8 +22,7 @@
classVariableNames:'BeepDuration NativeDialogs NativeFileDialogs NativeWidgets
NativeWidgetClassTable StandardColorValues IgnoreSysColorChanges
IgnoreFontChanges SystemColorValues CanEndSession
- VerboseNativeDialogs MonitorNameToCurrentResolution
- MonitorNameToVirtualResolution MonitorNameDictionariesSema'
+ VerboseNativeDialogs'
poolDictionaries:''
category:'Interface-Graphics'
!
@@ -5423,11 +5422,6 @@
IgnoreSysColorChanges := false.
SystemColorValues := IdentityDictionary new.
- "/ cache information we get from support/win32/displayResolutionTools
- MonitorNameToCurrentResolution := Dictionary new.
- MonitorNameToVirtualResolution := Dictionary new.
- MonitorNameDictionariesSema := Semaphore forMutualExclusion.
-
"/ translation table from ST/X windowType symbol (system-independent)
"/ to Windows windowClass (windows-specific).
@@ -5447,7 +5441,7 @@
).
"Modified: / 24-08-2010 / 16:42:23 / sr"
- "Modified: / 21-11-2019 / 10:04:42 / Stefan Reise"
+ "Modified: / 22-11-2019 / 15:18:45 / Stefan Reise"
!
initializeStandardColorNames
@@ -6665,171 +6659,6 @@
^ targetMonitorRealTopOrLeft + remainingReal
"Created: / 22-11-2019 / 10:37:55 / Stefan Reise"
-!
-
-primResolutionForMonitorNamed:aMonitorDeviceNameOrNil
- trueForVirtualResolutionOrFalseForCurrentResolution:trueForVirtualResolutionOrFalseForCurrentResolution
-
- "ATTENTION: can return nil if the package or the tools are missing:
- stx:support/win32/displayResolutionTools/bin/cdr.exe
- stx:support/win32/displayResolutionTools/bin/vdr.exe
-
- 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
- primResolutionForMonitorNamed:nil
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
-
- self
- primResolutionForMonitorNamed:'some nonsense'
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
-
- self
- primResolutionForMonitorNamed:'\\.\DISPLAY1'
- trueForVirtualResolutionOrFalseForCurrentResolution:false.
-
- self
- primResolutionForMonitorNamed:'\\.\DISPLAY1'
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
-
- self
- primResolutionForMonitorNamed:'\\.\DISPLAY2'
- trueForVirtualResolutionOrFalseForCurrentResolution:false.
-
- self
- primResolutionForMonitorNamed:'\\.\DISPLAY2'
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
- "
-
- |packageId directory toolBaseNameWithoutSuffix
- filenameOrNil output pointValues|
-
- aMonitorDeviceNameOrNil isNil ifTrue:[
- ^ nil
- ].
-
- packageId := 'stx:support/win32/displayResolutionTools/bin'.
- directory := Smalltalk packageDirectoryForPackageId:packageId.
- directory isNil ifTrue:[
- 'package "', packageId, '" is missing"' errorPrintCR.
- ^ nil
- ].
-
- trueForVirtualResolutionOrFalseForCurrentResolution ifTrue:[
- toolBaseNameWithoutSuffix := 'vdr'.
- ] ifFalse:[
- toolBaseNameWithoutSuffix := 'cdr'.
- ].
-
- filenameOrNil := directory / (toolBaseNameWithoutSuffix, '.exe').
- filenameOrNil isNil ifTrue:[
- ^ nil
- ].
- filenameOrNil exists ifFalse:[
- 'tool binary "', filenameOrNil nameString, '" is missing"' errorPrintCR.
- ^ nil
- ].
-
- output := '' writeStream.
-
- (OperatingSystem
- executeCommand:('"%1" %2'
- bindWith:filenameOrNil pathName
- with:aMonitorDeviceNameOrNil)
- outputTo:output
- errorTo:output) ifFalse:[
- ^ nil
- ].
-
- pointValues := output contents subStrings:$x.
-
- ^ pointValues first asInteger@pointValues second asInteger
-
- "Created: / 21-11-2019 / 10:07:34 / Stefan Reise"
-!
-
-resolutionForMonitorNamed:aMonitorDeviceName
- trueForVirtualResolutionOrFalseForCurrentResolution:trueForVirtualResolutionOrFalseForCurrentResolution
-
- "ATTENTION: can return nil if the package or the tools are missing:
- stx:support/win32/displayResolutionTools/bin/cdr.exe
- stx:support/win32/displayResolutionTools/bin/vdr.exe
-
- 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"
-
- "
- MonitorNameToCurrentResolution := Dictionary new.
- MonitorNameToVirtualResolution := Dictionary new.
-
- self
- resolutionForMonitorNamed:'\\.\DISPLAY1'
- trueForVirtualResolutionOrFalseForCurrentResolution:false.
-
- self
- resolutionForMonitorNamed:'\\.\DISPLAY1'
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
-
- self
- resolutionForMonitorNamed:'\\.\DISPLAY2'
- trueForVirtualResolutionOrFalseForCurrentResolution:false.
-
- self
- resolutionForMonitorNamed:'\\.\DISPLAY2'
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
- "
-
- |cacheDictionary currentResolution|
-
- aMonitorDeviceName isNil ifTrue:[
- ^ nil
- ].
-
- trueForVirtualResolutionOrFalseForCurrentResolution ifTrue:[
- cacheDictionary := MonitorNameToVirtualResolution.
- ] ifFalse:[
- cacheDictionary := MonitorNameToCurrentResolution.
- ].
-
- currentResolution := cacheDictionary
- at:aMonitorDeviceName
- ifAbsent:nil.
-
- currentResolution isNil ifTrue:[
- MonitorNameDictionariesSema critical:[
- currentResolution := cacheDictionary
- at:aMonitorDeviceName
- ifAbsentPut:[
- (self
- primResolutionForMonitorNamed:aMonitorDeviceName
- trueForVirtualResolutionOrFalseForCurrentResolution:trueForVirtualResolutionOrFalseForCurrentResolution)
- ? 0 "/ use 0 to indicate nil, avoid recalling of #displayResolutionForDisplayWithDeviceName:...
- ].
- ].
- ].
-
- currentResolution == 0 ifTrue:[
- ^ nil
- ].
-
- ^ currentResolution
-
- "Created: / 21-11-2019 / 10:06:51 / Stefan Reise"
- "Modified: / 22-11-2019 / 10:41:38 / Stefan Reise"
! !
!WinWorkstation class methodsFor:'queries'!
@@ -6852,42 +6681,115 @@
!WinWorkstation class methodsFor:'queries - monitor'!
-currentResolutionForMonitorNamed:aMonitorDeviceName
- "ATTENTION: can return nil if the package or the tool is missing:
- stx:support/win32/displayResolutionTools/bin/cdr.exe
-
- this is the current resolution of the display,
+currentMonitorResolutionByMonitorDeviceName:aMonitorDeviceName
+ "this is the current resolution of the display,
+ without any effect of scaling
+
+ for e.g.
+ real current resolution -> 1080p
+ scaling 150%
+ virtual resolution -> 720p
+
+ real current resolution -> 1080p
+ scaling 100%
+ virtual resolution -> 1080p"
+
+ "
+ Screen currentMonitorResolutionByMonitorDeviceName:'\\.\DISPLAY1'.
+ Screen currentMonitorResolutionByMonitorDeviceName:'\\.\DISPLAY2'.
+ "
+
+ |currentX currentY|
+
+ aMonitorDeviceName isEmptyOrNil ifTrue:[
+ ^ nil
+ ].
+
+%{
+ HDC hdc = CreateDCA(__stringVal(aMonitorDeviceName), NULL, NULL, NULL);
+ if (hdc == NULL) {
+ RETURN(nil);
+ }
+
+ currentX = __MKSMALLINT(GetDeviceCaps(hdc, DESKTOPHORZRES));
+ currentY = __MKSMALLINT(GetDeviceCaps(hdc, DESKTOPVERTRES));
+
+ DeleteDC(hdc);
+%}.
+
+ ^ currentX@currentY
+
+ "Created: / 22-11-2019 / 14:25:10 / Stefan Reise"
+!
+
+currentMonitorResolutionByPoint:aPoint
+ "this is the current resolution of the display,
without any effect of scaling
for e.g.
- real current display resolution -> 1080p
+ real current resolution -> 1080p
scaling 150%
- virtual display resolution -> 720p
-
- real current display resolution -> 1080p
+ virtual resolution -> 720p
+
+ real current resolution -> 1080p
scaling 100%
- virtual display resolution -> 1080p"
-
- "
- MonitorNameToCurrentResolution := Dictionary new.
- self currentResolutionForMonitorNamed:'\\.\DISPLAY1'.
- self currentResolutionForMonitorNamed:'\\.\DISPLAY2'.
+ virtual resolution -> 1080p"
+
+ "
+ Screen currentMonitorResolutionByPoint:nil.
+ Screen currentMonitorResolutionByPoint:0@0.
+ Screen currentMonitorResolutionByPoint:500@0.
+ Screen currentMonitorResolutionByPoint:2000@0.
"
- |currentResolution|
-
- currentResolution := self
- resolutionForMonitorNamed:aMonitorDeviceName
- trueForVirtualResolutionOrFalseForCurrentResolution:false.
-
- currentResolution isNil ifTrue:[
- ^ super currentResolutionForMonitorNamed:aMonitorDeviceName
- ].
-
- ^ currentResolution
-
- "Created: / 21-11-2019 / 10:10:16 / Stefan Reise"
- "Modified (comment): / 22-11-2019 / 10:22:06 / Stefan Reise"
+ |monitorName|
+
+ aPoint isNil ifTrue:[
+ ^ nil
+ ].
+
+ monitorName := self monitorDeviceNameForPoint:aPoint.
+ monitorName isNil ifTrue:[
+ ^ nil
+ ].
+
+ ^ self currentMonitorResolutionByMonitorDeviceName:monitorName
+
+ "Created: / 22-11-2019 / 14:26:31 / Stefan Reise"
+!
+
+currentMonitorResolutionByView:aView
+ "this is the current resolution of the display,
+ without any effect of scaling
+
+ for e.g.
+ real current resolution -> 1080p
+ scaling 150%
+ virtual resolution -> 720p
+
+ real current resolution -> 1080p
+ scaling 100%
+ virtual resolution -> 1080p"
+
+ "
+ Screen currentMonitorResolutionByView:nil.
+ Screen currentMonitorResolutionByView:Transcript topView.
+ "
+
+ |monitorName|
+
+ aView isNil ifTrue:[
+ ^ nil
+ ].
+
+ monitorName := self monitorDeviceNameForView:aView.
+ monitorName isNil ifTrue:[
+ ^ nil
+ ].
+
+ ^ self currentMonitorResolutionByMonitorDeviceName:monitorName
+
+ "Created: / 22-11-2019 / 14:22:47 / Stefan Reise"
!
monitorDeviceNameForPoint:aPoint
@@ -6985,13 +6887,13 @@
|currentMonitorResolution virtualMonitorResolution|
- currentMonitorResolution := self currentResolutionForMonitorNamed:aMonitorDeviceName.
+ currentMonitorResolution := self currentMonitorResolutionByMonitorDeviceName:aMonitorDeviceName.
currentMonitorResolution isNil ifTrue:[
"may the tool binary is missing"
^ super scaleFactorForMonitorNamed:aMonitorDeviceName
].
- virtualMonitorResolution := self virtualResolutionForMonitorNamed:aMonitorDeviceName.
+ virtualMonitorResolution := self virtualMonitorResolutionByMonitorDeviceName:aMonitorDeviceName.
virtualMonitorResolution isNil ifTrue:[
"may the tool binary is missing"
^ 1@1
@@ -7000,7 +6902,7 @@
^ currentMonitorResolution / virtualMonitorResolution
"Created: / 21-11-2019 / 10:12:00 / Stefan Reise"
- "Modified: / 22-11-2019 / 10:01:09 / Stefan Reise"
+ "Modified: / 22-11-2019 / 15:17:05 / Stefan Reise"
!
scaleFactorForRootViewTranslationOnMonitorNamed:aMonitorDeviceName
@@ -7022,7 +6924,7 @@
|currentMonitorResolution monitorHandle monitorInfo|
- currentMonitorResolution := Screen currentResolutionForMonitorNamed:aMonitorDeviceName.
+ currentMonitorResolution := Screen currentMonitorResolutionByMonitorDeviceName:aMonitorDeviceName.
currentMonitorResolution isNil ifTrue:[
"may the tool binary is missing"
^ super scaleFactorForRootViewTranslationOnMonitorNamed:aMonitorDeviceName
@@ -7045,48 +6947,127 @@
^ currentMonitorResolution / ((monitorInfo screenWidth)@(monitorInfo screenHeight))
"Created: / 21-11-2019 / 12:33:11 / Stefan Reise"
- "Modified (format): / 22-11-2019 / 10:23:16 / Stefan Reise"
-!
-
-virtualResolutionForMonitorNamed:aMonitorDeviceName
- "ATTENTION: can return nil if the package or the tool is missing:
- stx:support/win32/displayResolutionTools/bin/vdr.exe
-
- ATTENTION: this method always returns the virtual resolution,
+ "Modified: / 22-11-2019 / 15:16:25 / Stefan Reise"
+!
+
+virtualMonitorResolutionByMonitorDeviceName:aMonitorDeviceName
+ "ATTENTION: this method always returns the virtual resolution,
+ REGARDLESS if the application (stx, expecco) has a virtual resolution or not
+
+ this is the resolution of a virtual display,
+ this resolution is effected by the scaling
+
+ for e.g.
+ real current resolution -> 1080p
+ scaling 150%
+ virtual resolution -> 720p
+
+ real current resolution -> 1080p
+ scaling 100%
+ virtual resolution -> 1080p"
+
+ "
+ Screen virtualMonitorResolutionByMonitorDeviceName:'\\.\DISPLAY1'.
+ Screen virtualMonitorResolutionByMonitorDeviceName:'\\.\DISPLAY2'.
+ "
+
+ |virtualX virtualY|
+
+ aMonitorDeviceName isEmptyOrNil ifTrue:[
+ ^ nil
+ ].
+
+%{
+ HDC hdc = CreateDCA(__stringVal(aMonitorDeviceName), NULL, NULL, NULL);
+ if (hdc == NULL) {
+ RETURN(nil);
+ }
+
+ virtualX = __MKSMALLINT(GetDeviceCaps(hdc, HORZRES));
+ virtualY = __MKSMALLINT(GetDeviceCaps(hdc, VERTRES));
+
+ DeleteDC(hdc);
+%}.
+
+ ^ virtualX@virtualY
+
+ "Created: / 22-11-2019 / 14:28:41 / Stefan Reise"
+!
+
+virtualMonitorResolutionByPoint:aPoint
+ "ATTENTION: this method always returns the virtual resolution,
REGARDLESS if the application (stx, expecco) has a virtual resolution or not
this is the resolution of a virtual display,
this resolution is effected by the scaling
for e.g.
- real current display resolution -> 1080p
+ real current resolution -> 1080p
scaling 150%
- virtual display resolution -> 720p
-
- real current display resolution -> 1080p
+ virtual resolution -> 720p
+
+ real current resolution -> 1080p
scaling 100%
- virtual display resolution -> 1080p"
-
- "
- MonitorNameToVirtualResolution := Dictionary new.
- self virtualResolutionForMonitorNamed:'\\.\DISPLAY1'
- self virtualResolutionForMonitorNamed:'\\.\DISPLAY2'
+ virtual resolution -> 1080p"
+
+ "
+ Screen virtualMonitorResolutionByPoint:nil.
+ Screen virtualMonitorResolutionByPoint:0@0.
+ Screen virtualMonitorResolutionByPoint:500@0.
+ Screen virtualMonitorResolutionByPoint:2000@0.
"
- |virtualResolution|
-
- virtualResolution := self
- resolutionForMonitorNamed:aMonitorDeviceName
- trueForVirtualResolutionOrFalseForCurrentResolution:true.
-
- virtualResolution isNil ifTrue:[
- ^ 1@1
- ].
-
- ^ virtualResolution
-
- "Created: / 21-11-2019 / 10:13:54 / Stefan Reise"
- "Modified: / 22-11-2019 / 10:00:35 / Stefan Reise"
+ |monitorName|
+
+ aPoint isNil ifTrue:[
+ ^ nil
+ ].
+
+ monitorName := self monitorDeviceNameForPoint:aPoint.
+ monitorName isNil ifTrue:[
+ ^ nil
+ ].
+
+ ^ self virtualMonitorResolutionByMonitorDeviceName:monitorName
+
+ "Created: / 22-11-2019 / 14:28:55 / Stefan Reise"
+!
+
+virtualMonitorResolutionByView:aView
+ "ATTENTION: this method always returns the virtual resolution,
+ REGARDLESS if the application (stx, expecco) has a virtual resolution or not
+
+ this is the resolution of a virtual display,
+ this resolution is effected by the scaling
+
+ for e.g.
+ real current resolution -> 1080p
+ scaling 150%
+ virtual resolution -> 720p
+
+ real current resolution -> 1080p
+ scaling 100%
+ virtual resolution -> 1080p"
+
+ "
+ Screen virtualMonitorResolutionByView:nil.
+ Screen virtualMonitorResolutionByView:Transcript topView.
+ "
+
+ |monitorName|
+
+ aView isNil ifTrue:[
+ ^ nil
+ ].
+
+ monitorName := self monitorDeviceNameForView:aView.
+ monitorName isNil ifTrue:[
+ ^ nil
+ ].
+
+ ^ self virtualMonitorResolutionByMonitorDeviceName:monitorName
+
+ "Created: / 22-11-2019 / 14:29:09 / Stefan Reise"
! !
!WinWorkstation methodsFor:'accessing & queries'!