From 6cd3a225a10f1b974b9c273f4d40c03fcd42d1b0 Mon Sep 17 00:00:00 2001 From: Blair McGlashan Date: Wed, 11 Sep 2024 14:05:45 +0100 Subject: [PATCH] ShellView>>createAt:extent: may incorrectly position and scale window The position and extent passed to createAt:extent: are specified in 96-dpi co-ordinates. However, the scaling code treats them as system dpi co-ordinates in determining the monitor on which they are created. This may cause the window to be incorrectly placed. --- .../Dolphin/MVP/Base/UI.CreateWindow.cls | 2 +- .../Dolphin/MVP/Base/UI.DisplayMonitor.cls | 22 ++++++++++++------- .../MVP/Tests/UI.Tests.DialogViewTest.cls | 3 +-- .../MVP/Tests/UI.Tests.PresenterTest.cls | 4 ++++ .../MVP/Tests/UI.Tests.ShellViewTest.cls | 13 +++++++++++ 5 files changed, 33 insertions(+), 11 deletions(-) diff --git a/Core/Object Arts/Dolphin/MVP/Base/UI.CreateWindow.cls b/Core/Object Arts/Dolphin/MVP/Base/UI.CreateWindow.cls index b93ad1858..853d2c37a 100644 --- a/Core/Object Arts/Dolphin/MVP/Base/UI.CreateWindow.cls +++ b/Core/Object Arts/Dolphin/MVP/Base/UI.CreateWindow.cls @@ -78,7 +78,7 @@ resolveShellGeometry: aShellView ifFalse: [monitor nextWindowPosition]] ifFalse: ["Position was specified. Determine the monitor from that." - monitor := DisplayMonitor nearestPoint: position. + monitor := DisplayMonitor nearestPoint: position * SystemMetrics current dpi // dpi. targetDpi := monitor effectiveDpi. "Now we can calculate the extent as above" extent := extent = UseDefaultGeometry diff --git a/Core/Object Arts/Dolphin/MVP/Base/UI.DisplayMonitor.cls b/Core/Object Arts/Dolphin/MVP/Base/UI.DisplayMonitor.cls index 19162170f..7b2fb7fc0 100644 --- a/Core/Object Arts/Dolphin/MVP/Base/UI.DisplayMonitor.cls +++ b/Core/Object Arts/Dolphin/MVP/Base/UI.DisplayMonitor.cls @@ -58,14 +58,12 @@ adjustWindowRect: aRectangle yourself! cacheInfo - | buf | - buf := MONITORINFOEXW newBuffer. - (UserLibrary dpiAwareness inContextDo: [UserLibrary default getMonitorInfo: handle lpmi: buf]) - ifFalse: [Win32Error signal]. - workArea := buf workArea. - rectangle := buf rectangle. - deviceName := buf szDevice. - isPrimary := buf isPrimary.! + | monitorInfo | + monitorInfo := self infoWithDpiAwareness: UserLibrary dpiAwareness. + workArea := monitorInfo workArea. + rectangle := monitorInfo rectangle. + deviceName := monitorInfo szDevice. + isPrimary := monitorInfo isPrimary! cascadeOffset "Private - Answer the offset of a new default window position from the last. This should neatly cascade the windows in a diagonal down from a starting point inset from the top corner by one such offset. @@ -159,6 +157,13 @@ info (User32 getMonitorInfo: handle lpmi: info) ifFalse: [Win32Error signal]. ^info! +infoWithDpiAwareness: aDpiAwareness + | buf | + buf := MONITORINFOEXW newBuffer. + (aDpiAwareness inContextDo: [UserLibrary default getMonitorInfo: handle lpmi: buf]) + ifFalse: [Win32Error signal]. + ^buf! + isAttachedToDesktop "Answer whether the receiver has any displays attached to the desktop." @@ -259,6 +264,7 @@ handle!accessing!private! ! handle:!accessing!private! ! hash!comparing!public! ! info!accessing!private! ! +infoWithDpiAwareness:!enquiries!private! ! isAttachedToDesktop!public!testing! ! isPrimary!public!testing! ! metrics!accessing!public! ! diff --git a/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.DialogViewTest.cls b/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.DialogViewTest.cls index 388a9d898..e7312fb94 100644 --- a/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.DialogViewTest.cls +++ b/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.DialogViewTest.cls @@ -144,8 +144,7 @@ testCreatedNearOwnerModeless testInplaceNotRepositioned | desktopMonitors position dialog leftMonitor ownerRect | - desktopMonitors := DisplayMonitor desktopMonitors - asSortedCollection: [:a :b | a workArea topLeft < b workArea topLeft]. + desktopMonitors := self desktopMonitors. leftMonitor := desktopMonitors first. "This test requires multiple monitors arranged in a typical horizontal configuration. It could be made to work in a vertical configuration, but there isn't much value." self skipUnless: diff --git a/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.PresenterTest.cls b/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.PresenterTest.cls index bb3843d11..8a22ade36 100644 --- a/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.PresenterTest.cls +++ b/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.PresenterTest.cls @@ -19,6 +19,9 @@ UI.Tests.PresenterTest comment: ''! classToTest ^self subclassResponsibility! +desktopMonitors + ^DisplayMonitor desktopMonitors asSortedArray: [:a :b | a origin < b origin]! + destroyPresenter | shell | presenter ifNil: [^self]. @@ -203,6 +206,7 @@ waitForInputIdle !UI.Tests.PresenterTest categoriesForMethods! classToTest!constants!private! ! +desktopMonitors!helpers!private! ! destroyPresenter!public!Running! ! getTextExtent:!helpers!private! ! hasTestStbViewResources!private!testing! ! diff --git a/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.ShellViewTest.cls b/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.ShellViewTest.cls index 0a512c5cf..5515b79e4 100644 --- a/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.ShellViewTest.cls +++ b/Core/Object Arts/Dolphin/MVP/Tests/UI.Tests.ShellViewTest.cls @@ -72,6 +72,18 @@ testOpensOnForegroundMonitor shell3 := self createShell: self printString , ': shell3' centered: false. self assert: shell3 displayMonitor equals: primary! +testPositionAtOriginOfLastMonitor + | subject monitor designPosition designExtent | + monitor := self desktopMonitors last. + designPosition := (monitor infoWithDpiAwareness: DpiAwareness unaware) rcWork origin. + designExtent := 200 @ 100. + subject := shells add: ShellView new. + subject + createAt: designPosition extent: designExtent; + show. + self assert: subject position equals: monitor origin. + self assert: subject extent equals: designExtent * monitor dpi // USER_DEFAULT_SCREEN_DPI! + verifyUpgradedView: anInteger identifier: aResourceIdentifier | view | super verifyUpgradedView: anInteger identifier: aResourceIdentifier. @@ -88,6 +100,7 @@ classToTest!helpers!private! ! createShell:centered:!helpers!private! ! testDefaultPositioning!public!unit tests! ! testOpensOnForegroundMonitor!public!unit tests! ! +testPositionAtOriginOfLastMonitor!public!unit tests! ! verifyUpgradedView:identifier:!helpers!private! ! !