fix(macos): масштаб канвы берём у окна контрола, а не у главного экрана

backingScaleFactor главного экрана врёт, когда окно лежит на другом
мониторе. Спрашиваем масштаб у NSWindow того NSView, которому принадлежит
паинтбокс: это ровно то число, в котором Cocoa рисует эту канву, и оно
меняется само при перетаскивании окна между мониторами.

Objective-C по-прежнему живёт только в MacScale; наружу торчит
кроссплатформенная GetControlScale, которая на Windows/Linux сворачивается
в Result := 1.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-07-09 21:20:53 +03:00
co-authored by Claude Opus 4.8
parent fd8769898a
commit 388687d684
5 changed files with 63 additions and 3 deletions
+44
View File
@@ -10,11 +10,23 @@ unit PlatformUtils;
interface
{$IFNDEF HEADLESS}
uses
Controls;
{$ENDIF}
function HasOpenGLSpectrumSwitch: Boolean;
function CurrentScreenDPI: Integer;
// Целочисленный масштаб канвы экрана: 2 на Retina, 1 везде остальном.
// Windows/Linux всегда получают 1 ⇒ умножение на него ничего не меняет.
function GetScreenScale: Integer;
// То же, но для канвы конкретного контрола: на macOS масштаб берётся у окна,
// которому контрол принадлежит, а не у главного экрана. Это то самое число, в
// котором Cocoa рисует эту канву, и оно меняется, когда окно перетаскивают на
// монитор с другим масштабом. Так и надо считать размер offscreen-битмапа.
{$IFNDEF HEADLESS}
function GetControlScale(AControl: TControl): Integer;
{$ENDIF}
// Возвращает каталог для хранения конфигурации (с завершающим разделителем).
// macOS: ~/Library/Application Support/ewsdr/
// Linux: ~/.config/ewsdr/
@@ -57,6 +69,38 @@ begin
{$ENDIF}
end;
{$IFNDEF HEADLESS}
function GetControlScale(AControl: TControl): Integer;
{$IF DEFINED(DARWIN)}
var
Host: TWinControl;
begin
// У TPaintBox и прочих TGraphicControl своего NSView нет — рисуют они на
// канве ближайшего родителя с хендлом, его окно и спрашиваем.
if AControl is TWinControl then
Host := TWinControl(AControl)
else if AControl <> nil then
Host := AControl.Parent
else
Host := nil;
while (Host <> nil) and not Host.HandleAllocated do
Host := Host.Parent;
if Host <> nil then
Result := MacBackingScaleForView(Pointer(Host.Handle))
else
Result := 0;
// Контрола ещё нет на экране: до первой отрисовки сгодится главный экран.
if Result < 1 then
Result := GetScreenScale;
{$ELSE}
begin
Result := 1;
{$ENDIF}
end;
{$ENDIF}
function CurrentScreenDPI: Integer;
begin
{$IFNDEF HEADLESS}