mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 19:45:09 +00:00
ew8bakandClaude Opus 4.8
388687d684
backingScaleFactor главного экрана врёт, когда окно лежит на другом мониторе. Спрашиваем масштаб у NSWindow того NSView, которому принадлежит паинтбокс: это ровно то число, в котором Cocoa рисует эту канву, и оно меняется само при перетаскивании окна между мониторами. Objective-C по-прежнему живёт только в MacScale; наружу торчит кроссплатформенная GetControlScale, которая на Windows/Linux сворачивается в Result := 1. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
131 lines
4.1 KiB
ObjectPascal
131 lines
4.1 KiB
ObjectPascal
unit PlatformUtils;
|
||
|
||
{
|
||
PlatformUtils.pas - small helpers for desktop/runtime platform checks.
|
||
}
|
||
|
||
{$IFDEF FPC}
|
||
{$MODE Delphi}
|
||
{$ENDIF}
|
||
|
||
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/
|
||
// Windows: %APPDATA%\ewsdr\
|
||
function GetAppCfgDir: string;
|
||
|
||
implementation
|
||
|
||
uses
|
||
SysUtils {$IFNDEF HEADLESS}, Forms{$ENDIF}
|
||
{$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}, MacScale{$ENDIF};
|
||
|
||
function HasOpenGLSpectrumSwitch: Boolean;
|
||
var
|
||
I: Integer;
|
||
S: string;
|
||
begin
|
||
Result := False;
|
||
for I := 1 to ParamCount do
|
||
begin
|
||
S := LowerCase(ParamStr(I));
|
||
if (S = '--opengl') or (S = '-opengl') or (S = '/opengl') then
|
||
Exit(True);
|
||
end;
|
||
// Бандл под LaunchServices не может передать argv, поэтому тот же
|
||
// переключатель читается из окружения (Info.plist -> LSEnvironment).
|
||
S := LowerCase(Trim(GetEnvironmentVariable('EWSDR_OPENGL')));
|
||
if (S = '1') or (S = 'true') or (S = 'yes') or (S = 'on') then
|
||
Exit(True);
|
||
end;
|
||
|
||
function GetScreenScale: Integer;
|
||
begin
|
||
{$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}
|
||
// Cocoa рисует канву в физических пикселях, а TBitmap всегда 1x. Кто рисует
|
||
// через offscreen-битмап, должен растить его в GetScreenScale раз.
|
||
Result := MacBackingScale;
|
||
{$ELSE}
|
||
Result := 1;
|
||
{$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}
|
||
Result := Screen.PixelsPerInch;
|
||
if Result <= 0 then Result := 96;
|
||
{$ELSE}
|
||
Result := 96; // headless-демон без LCL: экрана нет, дефолт DPI
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function GetAppCfgDir: string;
|
||
begin
|
||
{$IFDEF WINDOWS}
|
||
Result := GetEnvironmentVariable('APPDATA');
|
||
if Result = '' then
|
||
Result := GetEnvironmentVariable('LOCALAPPDATA');
|
||
if Result = '' then
|
||
Result := ExtractFilePath(ParamStr(0));
|
||
Result := IncludeTrailingPathDelimiter(Result) + 'ewsdr' + PathDelim;
|
||
{$ELSE}
|
||
Result := IncludeTrailingPathDelimiter(GetAppConfigDir(False));
|
||
{$ENDIF}
|
||
if not DirectoryExists(Result) then
|
||
ForceDirectories(Result);
|
||
end;
|
||
|
||
end.
|