Files
ewsdr/MacScale.pas
ew8bakandClaude Opus 4.8 388687d684 fix(macos): масштаб канвы берём у окна контрола, а не у главного экрана
backingScaleFactor главного экрана врёт, когда окно лежит на другом
мониторе. Спрашиваем масштаб у NSWindow того NSView, которому принадлежит
паинтбокс: это ровно то число, в котором Cocoa рисует эту канву, и оно
меняется само при перетаскивании окна между мониторами.

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

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-09 21:20:53 +03:00

59 lines
2.1 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit MacScale;
{
MacScale.pas — единственное место, где проекту нужен Objective-C.
Вынесен из PlatformUtils, потому что {$MODESWITCH OBJECTIVEC1} несовместим
с {$MODE Delphi} (компилятор падает с internal error 200609171). Здесь свой
режим ObjFPC; наружу торчит одна обычная функция.
Модуль имеет смысл только на macOS с GUI: под HEADLESS и на других
платформах он не компилируется и не подключается.
}
{$MODE ObjFPC}{$H+}
{$MODESWITCH OBJECTIVEC1}
// FPC 3.2.4 падает с internal error 200609171, когда генерирует DWARF-3
// (-gw3, режим Debug у lazbuild) для Objective-C типов. Отладочная информация
// для этих сорока строк не нужна.
{$DEBUGINFO OFF}
interface
// Целочисленный масштаб основного экрана: 2 на Retina, 1 иначе.
function MacBackingScale: Integer;
// Масштаб окна, которому принадлежит NSView (Handle контрола LCL). Именно в
// этом масштабе Cocoa рисует канву контрола, и он меняется сам, когда окно
// перетаскивают между мониторами. Возвращает 0, если окна ещё нет.
function MacBackingScaleForView(AView: Pointer): Integer;
implementation
uses
CocoaAll;
function MacBackingScale: Integer;
var
Sc: NSScreen;
begin
Result := 1;
Sc := NSScreen.mainScreen;
if Sc = nil then Exit;
Result := Round(Sc.backingScaleFactor);
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.