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
+16
View File
@@ -22,6 +22,10 @@ interface
// Целочисленный масштаб основного экрана: 2 на Retina, 1 иначе.
function MacBackingScale: Integer;
// Масштаб окна, которому принадлежит NSView (Handle контрола LCL). Именно в
// этом масштабе Cocoa рисует канву контрола, и он меняется сам, когда окно
// перетаскивают между мониторами. Возвращает 0, если окна ещё нет.
function MacBackingScaleForView(AView: Pointer): Integer;
implementation
@@ -39,4 +43,16 @@ begin
if Result < 1 then Result := 1;
end;
function MacBackingScaleForView(AView: Pointer): Integer;
var
Wnd: NSWindow;
begin
Result := 0;
if AView = nil then Exit;
Wnd := NSView(AView).window;
if Wnd = nil then Exit; // контрол ещё не показан — масштаб неизвестен
Result := Round(Wnd.backingScaleFactor);
if Result < 1 then Result := 1;
end;
end.
+1 -1
View File
@@ -343,7 +343,7 @@ begin
if (W <= 0) or (H <= 0) then Exit;
// Битмап в физических пикселях канвы, иначе Cocoa растянет его и замылит.
FScale := GetScreenScale;
FScale := GetControlScale(FPb);
BmpW := W * FScale; BmpH := H * FScale;
if (FBmp.Width <> BmpW) or (FBmp.Height <> BmpH) then FBmp.SetSize(BmpW, BmpH);
+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}
+1 -1
View File
@@ -261,7 +261,7 @@ begin
// Окно могли перетащить на монитор с другим масштабом — кэш линейки тогда
// держит битмап прежнего разрешения, его надо выбросить.
NewScale := GetScreenScale;
NewScale := GetControlScale(PB);
if NewScale <> FScale then
begin
FScale := NewScale;
+1 -1
View File
@@ -500,7 +500,7 @@ begin
// Битмап держим в физических пикселях канвы, иначе Cocoa растянет его вдвое
// и картинка замылится. На Windows/Linux FScale=1 и всё как было.
FScale := GetScreenScale;
FScale := GetControlScale(PB);
BmpW := W * FScale; BmpH := H * FScale;
if (FSmBitmap = nil) or (FSmBitmap.Width <> BmpW) or (FSmBitmap.Height <> BmpH) then