ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 17:27:32 +00:00
Code Issues Packages Projects Releases Wiki Activity

fix(macos): S-метр, линейка и зумбар больше не мылятся на Retina

Browse Source 
Cocoa рисует канву в физических пикселях, TBitmap всегда 1x, поэтому кадр,
собранный в offscreen-битмап логического размера, растягивался вдвое.

PlatformUtils.GetScreenScale возвращает 2 на Retina и 1 на остальных
платформах. Масштаб — обычная переменная, а не условная компиляция: на
Windows/Linux умножение на 1 даёт прежние числа, а на канву кадр кладётся
через Draw, как и раньше (StretchDraw только при масштабе > 1).

В SMeterView, RulerView и PanZoomBar битмап растёт в S раз, пиксельные
константы, размеры шрифтов и толщина пера умножаются на S. Перо важно
отдельно: иначе на Retina все риски стали бы вдвое тоньше.

RulerView кэширует битмап, поэтому смена масштаба сбрасывает кэш.
PanZoomBar.ThumbGeom получил параметр AScale: отрисовка зовёт его с
физической шириной, хит-тест мыши — с логической, код мыши не менялся.

Objective-C изолирован в MacScale.pas: {$MODESWITCH OBJECTIVEC1} несовместим
с {$MODE Delphi}, а DWARF-3 (-gw3, Debug-режим lazbuild) роняет FPC 3.2.4 с
internal error 200609171 на любых Objective-C типах — отсюда {$DEBUGINFO OFF}.

Замер после правки: 37.5% CPU против 38% базовых, отрисовка этих трёх
элементов ниже уровня шума в профиле.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
ew8bak
2026-07-09 19:09:53 +03:00
co-authored by Claude Opus 4.8
parent 406f32b52c
commit fd8769898a
5 changed files with 232 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
RulerView.pas
+34 -14
View File
@@ -13,12 +13,14 @@ interface
uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
LCLIntf, LCLType, AppTheme;
LCLIntf, LCLType, AppTheme, PlatformUtils;
type
TRulerView = class
private
FRulerBitmap: TBitmap;
// Масштаб канвы: 2 на Retina, 1 на Windows/Linux.
FScale: Integer;
FRulerLastFreq: Double;
FRulerLastVfo: Double;
FRulerLastSpan: Double;
@@ -106,6 +108,7 @@ begin
FRulerLastSpan := -1.0;
FTheme := DarkTheme;
FSpanHz := 192000;
FScale := 1;
end;
destructor TRulerView.Destroy;
@@ -134,7 +137,7 @@ end;
procedure TRulerView.SetRulerSize(W, H: Integer);
begin
if (W <= 0) or (H <= 0) then Exit;
FRulerBitmap.SetSize(W, H);
FRulerBitmap.SetSize(W * FScale, H * FScale);
InvalidateRulerCache;
end;
@@ -163,9 +166,13 @@ var
Lbl: string; TW: Integer;
N, labelMult: Integer;
TickMaj, TickMin, LabelY: Integer;
Sc: Integer; // масштаб канвы, см. FScale
begin
if FPbRuler = nil then Exit;
W := FPbRuler.Width; H := FPbRuler.Height;
Sc := FScale;
// Битмап живёт в физических пикселях; вся геометрия ниже считается от W/H,
// поэтому масштабируется сама. Явно домножаем только константы и перо.
W := FPbRuler.Width * Sc; H := FPbRuler.Height * Sc;
if (W <= 0) or (H <= 0) then Exit;
if (Abs(FCenterFreq - FRulerLastFreq) < 0.5) and
(Abs(ActiveVfoFreq - FRulerLastVfo) < 0.5) and
@@ -175,19 +182,19 @@ begin
FRulerBitmap.SetSize(W, H);
C := FRulerBitmap.Canvas;
PaintVerticalGradientR(C, W, H, FTheme.RulerGradTop, FTheme.RulerGradBot);
C.Pen.Color := FTheme.RulerBorder; C.Pen.Width := 1;
C.Pen.Color := FTheme.RulerBorder; C.Pen.Width := Sc;
C.MoveTo(0, 0); C.LineTo(W, 0);
C.MoveTo(0, H-1); C.LineTo(W, H-1);
C.MoveTo(0, H-Sc); C.LineTo(W, H-Sc);
// Высота шрифта привязана к высоте линейки (H уже DPI-масштабирована в MainForm),
// а не к point-size — иначе на Windows-масштабе 125/150/200% текст не совпадал с
// высотой полосы (метки мелкие/обрезались). Теперь шрифт скейлится вместе с DPI.
C.Font.Name := 'Courier New'; C.Font.Style := [];
C.Font.Height := -Max(8, Round(H * 0.42));
C.Font.Height := -Max(8 * Sc, Round(H * 0.42));
C.Brush.Style := bsClear;
// Короткие ticks сверху + метка по центру оставшейся области (по TextHeight),
// чтобы цифры стояли по центру, а не уезжали вниз.
TickMaj := Max(4, Round(H * 0.34));
TickMin := Max(2, Round(H * 0.20));
TickMaj := Max(4 * Sc, Round(H * 0.34));
TickMin := Max(2 * Sc, Round(H * 0.20));
LabelY := TickMaj + ((H - TickMaj) - C.TextHeight('0')) div 2;
if LabelY < TickMaj then LabelY := TickMaj;
FreqStart := FCenterFreq - FSpanHz / 2;
@@ -195,7 +202,7 @@ begin
begin
pixPerStep := W * FFMGridStepHz / FSpanHz;
if pixPerStep >= 1.0 then
labelMult := Max(1, Ceil((C.TextWidth('000.000') + 6) / pixPerStep))
labelMult := Max(1, Ceil((C.TextWidth('000.000') + 6 * Sc) / pixPerStep))
else
labelMult := MaxInt;
N := Ceil(FreqStart / FFMGridStepHz);
@@ -238,8 +245,8 @@ begin
VfoX := Round((ActiveVfoFreq - FCenterFreq + FSpanHz/2) / FSpanHz * W);
if (VfoX >= 0) and (VfoX < W) then
begin
C.Pen.Color := FTheme.RulerVfo; C.Pen.Width := 2;
C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 1); C.Pen.Width := 1;
C.Pen.Color := FTheme.RulerVfo; C.Pen.Width := 2 * Sc;
C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - Sc); C.Pen.Width := Sc;
end;
end;
@@ -248,12 +255,25 @@ end;
// ────────────────────────────────────────────────────────────────────────────
procedure TRulerView.PaintRuler(Sender: TObject);
var PB: TPaintBox;
var PB: TPaintBox; NewScale: Integer;
begin
PB := TPaintBox(Sender);
// Окно могли перетащить на монитор с другим масштабом — кэш линейки тогда
// держит битмап прежнего разрешения, его надо выбросить.
NewScale := GetScreenScale;
if NewScale <> FScale then
begin
FScale := NewScale;
InvalidateRulerCache;
end;
DrawRuler;
if (FRulerBitmap.Width > 0) and (FRulerBitmap.Height > 0) then
PB.Canvas.Draw(0, 0, FRulerBitmap);
if (FRulerBitmap.Width <= 0) or (FRulerBitmap.Height <= 0) then Exit;
if FScale = 1 then
PB.Canvas.Draw(0, 0, FRulerBitmap)
else
PB.Canvas.StretchDraw(Rect(0, 0, PB.Width, PB.Height), FRulerBitmap);
end;
end.