ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 20:37:33 +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
MacScale.pas
+42
View File
@@ -0,0 +1,42 @@
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;
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;
end.
PanZoomBar.pas
+49 -28
View File
@@ -26,7 +26,7 @@ interface
uses uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
LCLIntf, LCLType, IntfGraphics, fpImage, AppTheme; LCLIntf, LCLType, IntfGraphics, fpImage, AppTheme, PlatformUtils;
type type
TPanZoomEvent = procedure(AZoom, APan: Double) of object; TPanZoomEvent = procedure(AZoom, APan: Double) of object;
@@ -47,9 +47,14 @@ type
FDragLo: Double; // зафиксированный левый край окна (для edge-зума), доля FDragLo: Double; // зафиксированный левый край окна (для edge-зума), доля
FDragHi: Double; // зафиксированный правый край окна, доля FDragHi: Double; // зафиксированный правый край окна, доля
FOnZoomPan: TPanZoomEvent; FOnZoomPan: TPanZoomEvent;
// Масштаб канвы: 2 на Retina, 1 на Windows/Linux. Только для отрисовки —
// мышь работает в логических координатах паинтбокса.
FScale: Integer;
function VisFraction: Double; // доля span, видимая при текущем зуме function VisFraction: Double; // доля span, видимая при текущем зуме
function ThumbGeom(W: Integer; out L, Wd: Integer): Boolean; // px-геометрия окна // AScale: 1 для хит-теста (логические px), FScale для отрисовки (физические).
function ThumbGeom(W: Integer; out L, Wd: Integer;
AScale: Integer = 1): Boolean;
procedure CurWindow(out Lo, Hi: Double); // доли краёв окна procedure CurWindow(out Lo, Hi: Double); // доли краёв окна
procedure EmitWindow(NewLo, NewHi: Double); // окно → zoom/pan + callback procedure EmitWindow(NewLo, NewHi: Double); // окно → zoom/pan + callback
function EdgePx(Wd: Integer): Integer; function EdgePx(Wd: Integer): Integer;
@@ -109,6 +114,7 @@ begin
FCenterFreq := 0.0; FCenterFreq := 0.0;
FSpanHz := 192000.0; FSpanHz := 192000.0;
FDragMode := dmNone; FDragMode := dmNone;
FScale := 1;
end; end;
destructor TPanZoomBar.Destroy; destructor TPanZoomBar.Destroy;
@@ -162,13 +168,14 @@ begin
Result := Max(3, Min(8, Wd div 3)); Result := Max(3, Min(8, Wd div 3));
end; end;
function TPanZoomBar.ThumbGeom(W: Integer; out L, Wd: Integer): Boolean; function TPanZoomBar.ThumbGeom(W: Integer; out L, Wd: Integer;
AScale: Integer = 1): Boolean;
var Lo, Hi: Double; var Lo, Hi: Double;
begin begin
Result := W > 0; Result := W > 0;
if not Result then begin L := 0; Wd := 0; Exit; end; if not Result then begin L := 0; Wd := 0; Exit; end;
CurWindow(Lo, Hi); CurWindow(Lo, Hi);
Wd := Max(MIN_THUMB_PX, Round((Hi - Lo) * W)); Wd := Max(MIN_THUMB_PX * AScale, Round((Hi - Lo) * W));
if Wd > W then Wd := W; if Wd > W then Wd := W;
L := Round(Lo * W); L := Round(Lo * W);
if L < 0 then L := 0; if L < 0 then L := 0;
@@ -199,7 +206,9 @@ var
i, X, TickMaj, TickMin, LabelY, NDiv, LabelEvery, TW: Integer; i, X, TickMaj, TickMin, LabelY, NDiv, LabelEvery, TW: Integer;
FreqStart, FreqHz, PixPerDiv: Double; FreqStart, FreqHz, PixPerDiv: Double;
Lbl: string; Lbl: string;
Sc: Integer; // масштаб канвы, см. FScale
begin begin
Sc := FScale;
C := FBmp.Canvas; C := FBmp.Canvas;
C.Brush.Style := bsSolid; C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.SliderBG; C.Brush.Color := FTheme.SliderBG;
@@ -207,11 +216,12 @@ begin
C.Font.Name := 'Courier New'; C.Font.Name := 'Courier New';
C.Font.Style := []; C.Font.Style := [];
C.Font.Height := -Max(7, Round(H * 0.40)); C.Font.Height := -Max(7 * Sc, Round(H * 0.40));
C.Brush.Style := bsClear; C.Brush.Style := bsClear;
C.Pen.Width := Sc;
TickMaj := Max(3, Round(H * 0.28)); TickMaj := Max(3 * Sc, Round(H * 0.28));
TickMin := Max(2, Round(H * 0.16)); TickMin := Max(2 * Sc, Round(H * 0.16));
LabelY := TickMaj + ((H - TickMaj) - C.TextHeight('0')) div 2; LabelY := TickMaj + ((H - TickMaj) - C.TextHeight('0')) div 2;
if LabelY < TickMaj then LabelY := TickMaj; if LabelY < TickMaj then LabelY := TickMaj;
@@ -219,14 +229,14 @@ begin
if FSpanHz <= 0 then Exit; if FSpanHz <= 0 then Exit;
FreqStart := FCenterFreq - FSpanHz / 2; FreqStart := FCenterFreq - FSpanHz / 2;
PixPerDiv := W / NDiv; PixPerDiv := W / NDiv;
if PixPerDiv >= (C.TextWidth('000.000') + 8) then LabelEvery := 1 if PixPerDiv >= (C.TextWidth('000.000') + 8 * Sc) then LabelEvery := 1
else if PixPerDiv * 2 >= (C.TextWidth('000.000') + 8) then LabelEvery := 2 else if PixPerDiv * 2 >= (C.TextWidth('000.000') + 8 * Sc) then LabelEvery := 2
else LabelEvery := 4; else LabelEvery := 4;
for i := 0 to NDiv do for i := 0 to NDiv do
begin begin
X := Round(i * PixPerDiv); X := Round(i * PixPerDiv);
if X >= W then X := W - 1; if X >= W then X := W - Sc;
C.Pen.Color := FTheme.RulerBorder; C.Pen.Color := FTheme.RulerBorder;
if (i mod LabelEvery) = 0 then if (i mod LabelEvery) = 0 then
begin begin
@@ -254,8 +264,10 @@ var
tR, tG, tB, bgR, bgG, bgB, nR, nG, nB: Integer; tR, tG, tB, bgR, bgG, bgB, nR, nG, nB: Integer;
A, RowT, Gloss: Double; A, RowT, Gloss: Double;
Active: Boolean; Active: Boolean;
Sc: Integer; // масштаб канвы, см. FScale
begin begin
if (Wd <= 0) or (W <= 0) or (H <= 2) then Exit; Sc := FScale;
if (Wd <= 0) or (W <= 0) or (H <= 2 * Sc) then Exit;
Active := FDragMode <> dmNone; Active := FDragMode <> dmNone;
if Active then if Active then
begin begin
@@ -270,8 +282,8 @@ begin
tB := GetBValue(ColorToRGB(FTheme.SliderThumbNorm)); tB := GetBValue(ColorToRGB(FTheme.SliderThumbNorm));
end; end;
top := 1; top := Sc;
bot := H - 2; bot := H - 2 * Sc;
Intf := FBmp.CreateIntfImage; Intf := FBmp.CreateIntfImage;
try try
for y := top to bot do for y := top to bot do
@@ -299,47 +311,56 @@ begin
// Объёмная фаска + маркеры краёв (две вертикальные риски — «ручки» ресайза). // Объёмная фаска + маркеры краёв (две вертикальные риски — «ручки» ресайза).
with FBmp.Canvas do with FBmp.Canvas do
begin begin
Pen.Width := 1; Brush.Style := bsClear; Pen.Width := Sc; Brush.Style := bsClear;
Pen.Color := FTheme.SliderThumbBdr; Pen.Color := FTheme.SliderThumbBdr;
Rectangle(L, top, L + Wd, bot + 1); Rectangle(L, top, L + Wd, bot + Sc);
Pen.Color := RGBToColor(EnsureRange(tR + 70, 0, 255), Pen.Color := RGBToColor(EnsureRange(tR + 70, 0, 255),
EnsureRange(tG + 70, 0, 255), EnsureRange(tG + 70, 0, 255),
EnsureRange(tB + 70, 0, 255)); EnsureRange(tB + 70, 0, 255));
MoveTo(L + 1, top + 1); LineTo(L + Wd - 1, top + 1); MoveTo(L + Sc, top + Sc); LineTo(L + Wd - Sc, top + Sc);
MoveTo(L + 1, top + 1); LineTo(L + 1, bot); MoveTo(L + Sc, top + Sc); LineTo(L + Sc, bot);
Pen.Color := RGBToColor(EnsureRange(tR - 60, 0, 255), Pen.Color := RGBToColor(EnsureRange(tR - 60, 0, 255),
EnsureRange(tG - 60, 0, 255), EnsureRange(tG - 60, 0, 255),
EnsureRange(tB - 60, 0, 255)); EnsureRange(tB - 60, 0, 255));
MoveTo(L + 1, bot); LineTo(L + Wd - 1, bot); MoveTo(L + Sc, bot); LineTo(L + Wd - Sc, bot);
MoveTo(L + Wd - 1, top + 1); LineTo(L + Wd - 1, bot + 1); MoveTo(L + Wd - Sc, top + Sc); LineTo(L + Wd - Sc, bot + Sc);
// «ручки» захвата по краям (видны, когда окно достаточно широкое) // «ручки» захвата по краям (видны, когда окно достаточно широкое)
if Wd >= 3 * MIN_THUMB_PX then if Wd >= 3 * MIN_THUMB_PX * Sc then
begin begin
Pen.Color := FTheme.SliderThumbBdr; Pen.Color := FTheme.SliderThumbBdr;
MoveTo(L + 3, top + 2); LineTo(L + 3, bot - 1); MoveTo(L + 3 * Sc, top + 2 * Sc); LineTo(L + 3 * Sc, bot - Sc);
MoveTo(L + Wd - 4, top + 2); LineTo(L + Wd - 4, bot - 1); MoveTo(L + Wd - 4 * Sc, top + 2 * Sc); LineTo(L + Wd - 4 * Sc, bot - Sc);
end; end;
Brush.Style := bsSolid; Brush.Style := bsSolid;
end; end;
end; end;
procedure TPanZoomBar.Paint(Sender: TObject); procedure TPanZoomBar.Paint(Sender: TObject);
var W, H, L, Wd: Integer; var W, H, BmpW, BmpH, L, Wd: Integer;
begin begin
if FPb = nil then Exit; if FPb = nil then Exit;
W := FPb.Width; H := FPb.Height; W := FPb.Width; H := FPb.Height;
if (W <= 0) or (H <= 0) then Exit; if (W <= 0) or (H <= 0) then Exit;
if (FBmp.Width <> W) or (FBmp.Height <> H) then FBmp.SetSize(W, H);
DrawRulerInto(W, H); // Битмап в физических пикселях канвы, иначе Cocoa растянет его и замылит.
if ThumbGeom(W, L, Wd) then BlendThumb(L, Wd, W, H); FScale := GetScreenScale;
BmpW := W * FScale; BmpH := H * FScale;
if (FBmp.Width <> BmpW) or (FBmp.Height <> BmpH) then FBmp.SetSize(BmpW, BmpH);
DrawRulerInto(BmpW, BmpH);
// Геометрия бегунка — в физических px; хит-тест в мыши зовёт ThumbGeom без масштаба.
if ThumbGeom(BmpW, L, Wd, FScale) then BlendThumb(L, Wd, BmpW, BmpH);
FBmp.Canvas.Brush.Style := bsClear; FBmp.Canvas.Brush.Style := bsClear;
FBmp.Canvas.Pen.Width := FScale;
FBmp.Canvas.Pen.Color := FTheme.RulerBorder; FBmp.Canvas.Pen.Color := FTheme.RulerBorder;
FBmp.Canvas.Rectangle(0, 0, W, H); FBmp.Canvas.Rectangle(0, 0, BmpW, BmpH);
FBmp.Canvas.Brush.Style := bsSolid; FBmp.Canvas.Brush.Style := bsSolid;
FPb.Canvas.Draw(0, 0, FBmp); if FScale = 1 then
FPb.Canvas.Draw(0, 0, FBmp)
else
FPb.Canvas.StretchDraw(Rect(0, 0, W, H), FBmp);
end; end;
procedure TPanZoomBar.HandleMouseDown(Button: TMouseButton; X, Y: Integer); procedure TPanZoomBar.HandleMouseDown(Button: TMouseButton; X, Y: Integer);
PlatformUtils.pas
+16 -1
View File
@@ -12,6 +12,9 @@ interface
function HasOpenGLSpectrumSwitch: Boolean; function HasOpenGLSpectrumSwitch: Boolean;
function CurrentScreenDPI: Integer; function CurrentScreenDPI: Integer;
// Целочисленный масштаб канвы экрана: 2 на Retina, 1 везде остальном.
// Windows/Linux всегда получают 1 ⇒ умножение на него ничего не меняет.
function GetScreenScale: Integer;
// Возвращает каталог для хранения конфигурации (с завершающим разделителем). // Возвращает каталог для хранения конфигурации (с завершающим разделителем).
// macOS: ~/Library/Application Support/ewsdr/ // macOS: ~/Library/Application Support/ewsdr/
// Linux: ~/.config/ewsdr/ // Linux: ~/.config/ewsdr/
@@ -21,7 +24,8 @@ function GetAppCfgDir: string;
implementation implementation
uses uses
SysUtils {$IFNDEF HEADLESS}, Forms{$ENDIF}; SysUtils {$IFNDEF HEADLESS}, Forms{$ENDIF}
{$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}, MacScale{$ENDIF};
function HasOpenGLSpectrumSwitch: Boolean; function HasOpenGLSpectrumSwitch: Boolean;
var var
@@ -42,6 +46,17 @@ begin
Exit(True); Exit(True);
end; end;
function GetScreenScale: Integer;
begin
{$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}
// Cocoa рисует канву в физических пикселях, а TBitmap всегда 1x. Кто рисует
// через offscreen-битмап, должен растить его в GetScreenScale раз.
Result := MacBackingScale;
{$ELSE}
Result := 1;
{$ENDIF}
end;
function CurrentScreenDPI: Integer; function CurrentScreenDPI: Integer;
begin begin
{$IFNDEF HEADLESS} {$IFNDEF HEADLESS}
RulerView.pas
+34 -14
View File
@@ -13,12 +13,14 @@ interface
uses uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
LCLIntf, LCLType, AppTheme; LCLIntf, LCLType, AppTheme, PlatformUtils;
type type
TRulerView = class TRulerView = class
private private
FRulerBitmap: TBitmap; FRulerBitmap: TBitmap;
// Масштаб канвы: 2 на Retina, 1 на Windows/Linux.
FScale: Integer;
FRulerLastFreq: Double; FRulerLastFreq: Double;
FRulerLastVfo: Double; FRulerLastVfo: Double;
FRulerLastSpan: Double; FRulerLastSpan: Double;
@@ -106,6 +108,7 @@ begin
FRulerLastSpan := -1.0; FRulerLastSpan := -1.0;
FTheme := DarkTheme; FTheme := DarkTheme;
FSpanHz := 192000; FSpanHz := 192000;
FScale := 1;
end; end;
destructor TRulerView.Destroy; destructor TRulerView.Destroy;
@@ -134,7 +137,7 @@ end;
procedure TRulerView.SetRulerSize(W, H: Integer); procedure TRulerView.SetRulerSize(W, H: Integer);
begin begin
if (W <= 0) or (H <= 0) then Exit; if (W <= 0) or (H <= 0) then Exit;
FRulerBitmap.SetSize(W, H); FRulerBitmap.SetSize(W * FScale, H * FScale);
InvalidateRulerCache; InvalidateRulerCache;
end; end;
@@ -163,9 +166,13 @@ var
Lbl: string; TW: Integer; Lbl: string; TW: Integer;
N, labelMult: Integer; N, labelMult: Integer;
TickMaj, TickMin, LabelY: Integer; TickMaj, TickMin, LabelY: Integer;
Sc: Integer; // масштаб канвы, см. FScale
begin begin
if FPbRuler = nil then Exit; 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 (W <= 0) or (H <= 0) then Exit;
if (Abs(FCenterFreq - FRulerLastFreq) < 0.5) and if (Abs(FCenterFreq - FRulerLastFreq) < 0.5) and
(Abs(ActiveVfoFreq - FRulerLastVfo) < 0.5) and (Abs(ActiveVfoFreq - FRulerLastVfo) < 0.5) and
@@ -175,19 +182,19 @@ begin
FRulerBitmap.SetSize(W, H); FRulerBitmap.SetSize(W, H);
C := FRulerBitmap.Canvas; C := FRulerBitmap.Canvas;
PaintVerticalGradientR(C, W, H, FTheme.RulerGradTop, FTheme.RulerGradBot); 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, 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), // Высота шрифта привязана к высоте линейки (H уже DPI-масштабирована в MainForm),
// а не к point-size — иначе на Windows-масштабе 125/150/200% текст не совпадал с // а не к point-size — иначе на Windows-масштабе 125/150/200% текст не совпадал с
// высотой полосы (метки мелкие/обрезались). Теперь шрифт скейлится вместе с DPI. // высотой полосы (метки мелкие/обрезались). Теперь шрифт скейлится вместе с DPI.
C.Font.Name := 'Courier New'; C.Font.Style := []; 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; C.Brush.Style := bsClear;
// Короткие ticks сверху + метка по центру оставшейся области (по TextHeight), // Короткие ticks сверху + метка по центру оставшейся области (по TextHeight),
// чтобы цифры стояли по центру, а не уезжали вниз. // чтобы цифры стояли по центру, а не уезжали вниз.
TickMaj := Max(4, Round(H * 0.34)); TickMaj := Max(4 * Sc, Round(H * 0.34));
TickMin := Max(2, Round(H * 0.20)); TickMin := Max(2 * Sc, Round(H * 0.20));
LabelY := TickMaj + ((H - TickMaj) - C.TextHeight('0')) div 2; LabelY := TickMaj + ((H - TickMaj) - C.TextHeight('0')) div 2;
if LabelY < TickMaj then LabelY := TickMaj; if LabelY < TickMaj then LabelY := TickMaj;
FreqStart := FCenterFreq - FSpanHz / 2; FreqStart := FCenterFreq - FSpanHz / 2;
@@ -195,7 +202,7 @@ begin
begin begin
pixPerStep := W * FFMGridStepHz / FSpanHz; pixPerStep := W * FFMGridStepHz / FSpanHz;
if pixPerStep >= 1.0 then 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 else
labelMult := MaxInt; labelMult := MaxInt;
N := Ceil(FreqStart / FFMGridStepHz); N := Ceil(FreqStart / FFMGridStepHz);
@@ -238,8 +245,8 @@ begin
VfoX := Round((ActiveVfoFreq - FCenterFreq + FSpanHz/2) / FSpanHz * W); VfoX := Round((ActiveVfoFreq - FCenterFreq + FSpanHz/2) / FSpanHz * W);
if (VfoX >= 0) and (VfoX < W) then if (VfoX >= 0) and (VfoX < W) then
begin begin
C.Pen.Color := FTheme.RulerVfo; C.Pen.Width := 2; C.Pen.Color := FTheme.RulerVfo; C.Pen.Width := 2 * Sc;
C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 1); C.Pen.Width := 1; C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - Sc); C.Pen.Width := Sc;
end; end;
end; end;
@@ -248,12 +255,25 @@ end;
// ──────────────────────────────────────────────────────────────────────────── // ────────────────────────────────────────────────────────────────────────────
procedure TRulerView.PaintRuler(Sender: TObject); procedure TRulerView.PaintRuler(Sender: TObject);
var PB: TPaintBox; var PB: TPaintBox; NewScale: Integer;
begin begin
PB := TPaintBox(Sender); PB := TPaintBox(Sender);
// Окно могли перетащить на монитор с другим масштабом — кэш линейки тогда
// держит битмап прежнего разрешения, его надо выбросить.
NewScale := GetScreenScale;
if NewScale <> FScale then
begin
FScale := NewScale;
InvalidateRulerCache;
end;
DrawRuler; DrawRuler;
if (FRulerBitmap.Width > 0) and (FRulerBitmap.Height > 0) then if (FRulerBitmap.Width <= 0) or (FRulerBitmap.Height <= 0) then Exit;
PB.Canvas.Draw(0, 0, FRulerBitmap); if FScale = 1 then
PB.Canvas.Draw(0, 0, FRulerBitmap)
else
PB.Canvas.StretchDraw(Rect(0, 0, PB.Width, PB.Height), FRulerBitmap);
end; end;
end. end.
SMeterView.pas
+91 -69
View File
@@ -13,7 +13,7 @@ interface
uses uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
IntfGraphics, FPImage, LCLType, GraphType, AppTheme; IntfGraphics, FPImage, LCLType, GraphType, AppTheme, PlatformUtils;
const const
SM_CLR_METER_ON = TColor($0000CC44); SM_CLR_METER_ON = TColor($0000CC44);
@@ -32,6 +32,9 @@ type
FPAMaxPower: Double; FPAMaxPower: Double;
FTransmitting: Boolean; FTransmitting: Boolean;
FPbSMeterRight: TPaintBox; FPbSMeterRight: TPaintBox;
// Масштаб канвы: 2 на Retina, 1 на Windows/Linux. Битмап растёт во столько
// же раз, пиксельные константы и шрифты умножаются на него.
FScale: Integer;
procedure DrawSMeterWide(ACanvas: TCanvas; R: TRect; procedure DrawSMeterWide(ACanvas: TCanvas; R: TRect;
Value, Peak, MinVal: Double; Value, Peak, MinVal: Double;
@@ -74,6 +77,7 @@ begin
FLastSWR := 1; FLastSWR := 1;
FPAMaxPower := 100.0; FPAMaxPower := 100.0;
FTransmitting := False; FTransmitting := False;
FScale := 1;
end; end;
destructor TSMeterView.Destroy; destructor TSMeterView.Destroy;
@@ -112,6 +116,7 @@ var
i, X, TW: Integer; Lbl: string; SNum, Over: Integer; i, X, TW: Integer; Lbl: string; SNum, Over: Integer;
LblDbm, LblS: string; LblDbm, LblS: string;
TWDbm, LblZoneL, TH10, TH6, MaxTWDbm, MaxTWS, LabelNeed: Integer; TWDbm, LblZoneL, TH10, TH6, MaxTWDbm, MaxTWS, LabelNeed: Integer;
Sc: Integer; // масштаб канвы, см. FScale
function DBtoX(dB: Double): Integer; inline; function DBtoX(dB: Double): Integer; inline;
begin begin
@@ -146,9 +151,10 @@ begin
CLR_SCALE_S_BLUE := FTheme.SMeterScaleSBlue; CLR_SCALE_S_BLUE := FTheme.SMeterScaleSBlue;
CLR_BDR := FTheme.SMeterBdr; CLR_BDR := FTheme.SMeterBdr;
Sc := FScale;
W := R.Right - R.Left; H := R.Bottom - R.Top; W := R.Right - R.Left; H := R.Bottom - R.Top;
ZX1 := 0; ZX2 := 0; ZY1 := 0; ZY2 := 0; ZX1 := 0; ZX2 := 0; ZY1 := 0; ZY2 := 0;
if (W < 80) or (H < 16) then Exit; if (W < 80 * Sc) or (H < 16 * Sc) then Exit;
LblDbm := Format('%.1f', [Value]); LblDbm := Format('%.1f', [Value]);
if Value >= -73.0 then if Value >= -73.0 then
@@ -164,14 +170,14 @@ begin
end; end;
ACanvas.Font.Name := 'Courier New'; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Name := 'Courier New'; ACanvas.Font.Style := [fsBold];
ACanvas.Font.Size := 10; TWDbm := ACanvas.TextWidth(LblDbm); ACanvas.Font.Size := 10 * Sc; TWDbm := ACanvas.TextWidth(LblDbm);
MaxTWDbm := ACanvas.TextWidth('-120.0'); MaxTWDbm := ACanvas.TextWidth('-120.0');
MaxTWS := ACanvas.TextWidth('S9+60'); MaxTWS := ACanvas.TextWidth('S9+60');
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := [];
LabelNeed := Max(MaxTWDbm + 2 + ACanvas.TextWidth('dBm '), MaxTWS) + LABEL_PAD * 2; LabelNeed := Max(MaxTWDbm + 2 * Sc + ACanvas.TextWidth('dBm '), MaxTWS) + LABEL_PAD * 2 * Sc;
LeftInfo := Max(LEFT_INFO_MIN, LabelNeed + 4); LeftInfo := Max(LEFT_INFO_MIN * Sc, LabelNeed + 4 * Sc);
BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD; BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD * Sc;
if BW < 10 then Exit; if BW < 10 * Sc then Exit;
LblZoneL := BX - LabelNeed; LblZoneL := BX - LabelNeed;
Y_BAR_TOP := R.Top + H * 44 div 100; Y_BAR_TOP := R.Top + H * 44 div 100;
@@ -180,6 +186,8 @@ begin
ACanvas.Brush.Color := CLR_SMETER_BG; ACanvas.Brush.Style := bsSolid; ACanvas.Brush.Color := CLR_SMETER_BG; ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Style := psClear; ACanvas.FillRect(R); ACanvas.Pen.Style := psSolid; ACanvas.Pen.Style := psClear; ACanvas.FillRect(R); ACanvas.Pen.Style := psSolid;
// Перо в физических пикселях: иначе на Retina все риски станут вдвое тоньше.
ACanvas.Pen.Width := Sc;
FillBar(BX, Y_BAR_TOP, S9X, Y_BAR_BOT, CLR_BAR_GREEN); FillBar(BX, Y_BAR_TOP, S9X, Y_BAR_BOT, CLR_BAR_GREEN);
FillBar(S9X, Y_BAR_TOP, OvrX, Y_BAR_BOT, CLR_BAR_GREEN); FillBar(S9X, Y_BAR_TOP, OvrX, Y_BAR_BOT, CLR_BAR_GREEN);
FillBar(OvrX, Y_BAR_TOP, BX + BW, Y_BAR_BOT, CLR_BAR_OVER); FillBar(OvrX, Y_BAR_TOP, BX + BW, Y_BAR_BOT, CLR_BAR_OVER);
@@ -189,65 +197,65 @@ begin
PeakRight := DBtoX(Peak); PeakRight := DBtoX(Peak);
ZX1 := Max(BX + 1, Min(PeakLeft, PeakRight)); ZX1 := Max(BX + 1, Min(PeakLeft, PeakRight));
ZX2 := Min(BX + BW - 1, Max(PeakLeft, PeakRight)); ZX2 := Min(BX + BW - 1, Max(PeakLeft, PeakRight));
ZY1 := Y_BAR_TOP + 1; ZY2 := Y_BAR_BOT - 1; ZY1 := Y_BAR_TOP + Sc; ZY2 := Y_BAR_BOT - Sc;
if BarEnd > BX then if BarEnd > BX then
begin begin
if BarEnd <= S9X then if BarEnd <= S9X then
FillBar(BX, Y_BAR_TOP+1, BarEnd, Y_BAR_BOT-1, CLR_BAR_GREEN) FillBar(BX, Y_BAR_TOP+Sc, BarEnd, Y_BAR_BOT-Sc, CLR_BAR_GREEN)
else begin else begin
FillBar(BX, Y_BAR_TOP+1, S9X, Y_BAR_BOT-1, CLR_BAR_GREEN); FillBar(BX, Y_BAR_TOP+Sc, S9X, Y_BAR_BOT-Sc, CLR_BAR_GREEN);
FillBar(S9X, Y_BAR_TOP+1, BarEnd, Y_BAR_BOT-1, CLR_BAR_OVER); FillBar(S9X, Y_BAR_TOP+Sc, BarEnd, Y_BAR_BOT-Sc, CLR_BAR_OVER);
end; end;
end; end;
if (PeakRight > BX) and (PeakRight <= BX + BW) then if (PeakRight > BX) and (PeakRight <= BX + BW) then
begin begin
ACanvas.Pen.Color := CLR_PEAK_MARKER; ACanvas.Pen.Width := 2; ACanvas.Pen.Color := CLR_PEAK_MARKER; ACanvas.Pen.Width := 2 * Sc;
ACanvas.MoveTo(PeakRight, Y_BAR_TOP - (Y_BAR_BOT - Y_BAR_TOP)); ACanvas.MoveTo(PeakRight, Y_BAR_TOP - (Y_BAR_BOT - Y_BAR_TOP));
ACanvas.LineTo(PeakRight, Y_BAR_BOT + (Y_BAR_BOT - Y_BAR_TOP)); ACanvas.LineTo(PeakRight, Y_BAR_BOT + (Y_BAR_BOT - Y_BAR_TOP));
ACanvas.Pen.Width := 1; ACanvas.Pen.Width := Sc;
end; end;
ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := CLR_BDR; ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := CLR_BDR;
ACanvas.Rectangle(LblZoneL, Y_BAR_TOP, BX + BW, Y_BAR_BOT); ACanvas.Rectangle(LblZoneL, Y_BAR_TOP, BX + BW, Y_BAR_BOT);
ACanvas.Pen.Color := FTheme.SMeterDivider; ACanvas.Pen.Color := FTheme.SMeterDivider;
ACanvas.MoveTo(BX, Y_BAR_TOP + 1); ACanvas.LineTo(BX, Y_BAR_BOT - 1); ACanvas.MoveTo(BX, Y_BAR_TOP + Sc); ACanvas.LineTo(BX, Y_BAR_BOT - Sc);
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Brush.Style := bsClear; ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; ACanvas.Brush.Style := bsClear;
for i := 0 to High(DBM_MARKS) do for i := 0 to High(DBM_MARKS) do
begin begin
X := DBtoX(DBM_MARKS[i]); X := DBtoX(DBM_MARKS[i]);
VLine(X, Y_BAR_TOP - TICK_LONG, Y_BAR_TOP - 1, CLR_TICK_WHITE); VLine(X, Y_BAR_TOP - TICK_LONG * Sc, Y_BAR_TOP - Sc, CLR_TICK_WHITE);
Lbl := DBM_LABELS[i]; TW := ACanvas.TextWidth(Lbl); Lbl := DBM_LABELS[i]; TW := ACanvas.TextWidth(Lbl);
ACanvas.Font.Color := CLR_SCALE_DBM; ACanvas.Font.Color := CLR_SCALE_DBM;
ACanvas.TextOut(X - TW div 2, Y_BAR_TOP - TICK_LONG - ACanvas.TextHeight(Lbl) - 1, Lbl); ACanvas.TextOut(X - TW div 2, Y_BAR_TOP - TICK_LONG * Sc - ACanvas.TextHeight(Lbl) - Sc, Lbl);
end; end;
i := -125; i := -125;
while i < -13 do while i < -13 do
begin begin
X := DBtoX(i); VLine(X, Y_BAR_TOP - TICK_MED, Y_BAR_TOP - 1, CLR_TICK_GREEN); X := DBtoX(i); VLine(X, Y_BAR_TOP - TICK_MED * Sc, Y_BAR_TOP - Sc, CLR_TICK_GREEN);
Inc(i, 5); Inc(i, 5);
end; end;
for i := 0 to High(S_MARKS_DBM) do for i := 0 to High(S_MARKS_DBM) do
begin begin
X := DBtoX(S_MARKS_DBM[i]); X := DBtoX(S_MARKS_DBM[i]);
if S_MARKS_DBM[i] >= DB_S9 then VLine(X, Y_BAR_BOT+1, Y_BAR_BOT+TICK_LONG, CLR_TICK_BLUE) if S_MARKS_DBM[i] >= DB_S9 then VLine(X, Y_BAR_BOT+Sc, Y_BAR_BOT+TICK_LONG*Sc, CLR_TICK_BLUE)
else VLine(X, Y_BAR_BOT+1, Y_BAR_BOT+TICK_LONG, CLR_TICK_GREEN); else VLine(X, Y_BAR_BOT+Sc, Y_BAR_BOT+TICK_LONG*Sc, CLR_TICK_GREEN);
Lbl := S_MARKS_LBL[i]; TW := ACanvas.TextWidth(Lbl); Lbl := S_MARKS_LBL[i]; TW := ACanvas.TextWidth(Lbl);
if S_MARKS_DBM[i] >= DB_S9 then ACanvas.Font.Color := CLR_SCALE_S_BLUE if S_MARKS_DBM[i] >= DB_S9 then ACanvas.Font.Color := CLR_SCALE_S_BLUE
else ACanvas.Font.Color := CLR_SCALE_S_GREEN; else ACanvas.Font.Color := CLR_SCALE_S_GREEN;
ACanvas.TextOut(X - TW div 2, Y_BAR_BOT + TICK_LONG + 1, Lbl); ACanvas.TextOut(X - TW div 2, Y_BAR_BOT + TICK_LONG * Sc + Sc, Lbl);
end; end;
ACanvas.Brush.Style := bsClear; ACanvas.Brush.Style := bsClear;
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0'); ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0');
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0'); ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0');
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM; ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM;
ACanvas.TextOut(LblZoneL + 4, Y_BAR_TOP - TH10 - 2, LblDbm); ACanvas.TextOut(LblZoneL + 4 * Sc, Y_BAR_TOP - TH10 - 2 * Sc, LblDbm);
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Font.Color := CLR_TICK_BLUE; ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; ACanvas.Font.Color := CLR_TICK_BLUE;
ACanvas.TextOut(LblZoneL + 4 + TWDbm + 2, Y_BAR_TOP - TH6 - 4, 'dBm'); ACanvas.TextOut(LblZoneL + 4 * Sc + TWDbm + 2 * Sc, Y_BAR_TOP - TH6 - 4 * Sc, 'dBm');
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_S; ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_S;
ACanvas.TextOut(LblZoneL + 4, Y_BAR_BOT + 2, LblS); ACanvas.TextOut(LblZoneL + 4 * Sc, Y_BAR_BOT + 2 * Sc, LblS);
end; end;
// ──────────────────────────────────────────────────────────────────────────── // ────────────────────────────────────────────────────────────────────────────
@@ -300,6 +308,7 @@ var
PBarEnd, SBarEnd, S_WarnX: Integer; PBarEnd, SBarEnd, S_WarnX: Integer;
LblPwr, LblSWR: string; LblPwr, LblSWR: string;
TWPwr, LblZoneL, TH10, TH6, MaxTWPwr, MaxTWSWR, LabelNeed: Integer; TWPwr, LblZoneL, TH10, TH6, MaxTWPwr, MaxTWSWR, LabelNeed: Integer;
Sc: Integer; // масштаб канвы, см. FScale
i, X, TW: Integer; i, X, TW: Integer;
Lbl: string; Lbl: string;
SWRHigh: Boolean; SWRHigh: Boolean;
@@ -345,23 +354,24 @@ begin
CLR_BDR := FTheme.SMeterBdr; CLR_BDR := FTheme.SMeterBdr;
CLR_SWR_HIGH := TColor($000000CC); CLR_SWR_HIGH := TColor($000000CC);
Sc := FScale;
W := R.Right - R.Left; H := R.Bottom - R.Top; W := R.Right - R.Left; H := R.Bottom - R.Top;
if (W < 80) or (H < 16) then Exit; if (W < 80 * Sc) or (H < 16 * Sc) then Exit;
SWRHigh := FLastSWR > SWR_HIGH_THRESH; SWRHigh := FLastSWR > SWR_HIGH_THRESH;
LblPwr := Format('%.0fW', [FLastFwdW]); LblPwr := Format('%.0fW', [FLastFwdW]);
LblSWR := Format('SWR:%.1f', [FLastSWR]); LblSWR := Format('SWR:%.1f', [FLastSWR]);
ACanvas.Font.Name := 'Courier New'; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Name := 'Courier New'; ACanvas.Font.Style := [fsBold];
ACanvas.Font.Size := 10; ACanvas.Font.Size := 10 * Sc;
TWPwr := ACanvas.TextWidth(LblPwr); TWPwr := ACanvas.TextWidth(LblPwr);
MaxTWPwr := ACanvas.TextWidth(Format('%.0fW', [FPAMaxPower])); MaxTWPwr := ACanvas.TextWidth(Format('%.0fW', [FPAMaxPower]));
MaxTWSWR := ACanvas.TextWidth('SWR:10.0'); MaxTWSWR := ACanvas.TextWidth('SWR:10.0');
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := [];
LabelNeed := Max(MaxTWPwr, MaxTWSWR) + LABEL_PAD * 2; LabelNeed := Max(MaxTWPwr, MaxTWSWR) + LABEL_PAD * 2 * Sc;
LeftInfo := Max(LEFT_INFO_MIN, LabelNeed + 4); LeftInfo := Max(LEFT_INFO_MIN * Sc, LabelNeed + 4 * Sc);
BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD; BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD * Sc;
if BW < 10 then Exit; if BW < 10 * Sc then Exit;
LblZoneL := BX - LabelNeed; LblZoneL := BX - LabelNeed;
Y_BAR_TOP := R.Top + H * 44 div 100; Y_BAR_TOP := R.Top + H * 44 div 100;
@@ -369,14 +379,16 @@ begin
Y_BAR_MID := (Y_BAR_TOP + Y_BAR_BOT) div 2; Y_BAR_MID := (Y_BAR_TOP + Y_BAR_BOT) div 2;
PY1 := Y_BAR_TOP; PY1 := Y_BAR_TOP;
PY2 := Y_BAR_MID - 1; PY2 := Y_BAR_MID - Sc;
SY1 := Y_BAR_MID + 1; SY1 := Y_BAR_MID + Sc;
SY2 := Y_BAR_BOT; SY2 := Y_BAR_BOT;
S_WarnX := SWRToX(SWR_HIGH_THRESH); S_WarnX := SWRToX(SWR_HIGH_THRESH);
ACanvas.Brush.Color := CLR_SMETER_BG; ACanvas.Brush.Style := bsSolid; ACanvas.Brush.Color := CLR_SMETER_BG; ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Style := psClear; ACanvas.FillRect(R); ACanvas.Pen.Style := psSolid; ACanvas.Pen.Style := psClear; ACanvas.FillRect(R); ACanvas.Pen.Style := psSolid;
// Перо в физических пикселях, как и в DrawSMeterWide.
ACanvas.Pen.Width := Sc;
FillBar(BX, PY1, BX + BW, PY2, CLR_BAR_GREEN); FillBar(BX, PY1, BX + BW, PY2, CLR_BAR_GREEN);
FillBar(BX, SY1, S_WarnX, SY2, CLR_BAR_GREEN); FillBar(BX, SY1, S_WarnX, SY2, CLR_BAR_GREEN);
@@ -384,16 +396,16 @@ begin
if FPAMaxPower > 0 then PwrPct := FLastFwdW / FPAMaxPower else PwrPct := 0; if FPAMaxPower > 0 then PwrPct := FLastFwdW / FPAMaxPower else PwrPct := 0;
PBarEnd := PwrToX(PwrPct); PBarEnd := PwrToX(PwrPct);
FillBar(BX, PY1 + 1, PBarEnd, PY2 - 1, SM_CLR_METER_ON); FillBar(BX, PY1 + Sc, PBarEnd, PY2 - Sc, SM_CLR_METER_ON);
SBarEnd := SWRToX(FLastSWR); SBarEnd := SWRToX(FLastSWR);
if not SWRHigh then if not SWRHigh then
FillBar(BX, SY1 + 1, SBarEnd, SY2 - 1, SM_CLR_AMBER) FillBar(BX, SY1 + Sc, SBarEnd, SY2 - Sc, SM_CLR_AMBER)
else else
begin begin
FillBar(BX, SY1 + 1, Min(S_WarnX, SBarEnd), SY2 - 1, SM_CLR_AMBER); FillBar(BX, SY1 + Sc, Min(S_WarnX, SBarEnd), SY2 - Sc, SM_CLR_AMBER);
if SBarEnd > S_WarnX then if SBarEnd > S_WarnX then
FillBar(S_WarnX, SY1 + 1, SBarEnd, SY2 - 1, CLR_SWR_HIGH); FillBar(S_WarnX, SY1 + Sc, SBarEnd, SY2 - Sc, CLR_SWR_HIGH);
end; end;
VLine(S_WarnX, SY1, SY2, FTheme.SMeterDivider); VLine(S_WarnX, SY1, SY2, FTheme.SMeterDivider);
@@ -405,10 +417,10 @@ begin
ACanvas.Rectangle(LblZoneL, SY1, BX + BW, SY2); ACanvas.Rectangle(LblZoneL, SY1, BX + BW, SY2);
ACanvas.Pen.Color := FTheme.SMeterDivider; ACanvas.Pen.Color := FTheme.SMeterDivider;
ACanvas.MoveTo(BX, PY1 + 1); ACanvas.LineTo(BX, PY2 - 1); ACanvas.MoveTo(BX, PY1 + Sc); ACanvas.LineTo(BX, PY2 - Sc);
ACanvas.MoveTo(BX, SY1 + 1); ACanvas.LineTo(BX, SY2 - 1); ACanvas.MoveTo(BX, SY1 + Sc); ACanvas.LineTo(BX, SY2 - Sc);
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Brush.Style := bsClear; ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; ACanvas.Brush.Style := bsClear;
i := 5; i := 5;
while i < 100 do while i < 100 do
@@ -416,7 +428,7 @@ begin
if (i mod 25) <> 0 then if (i mod 25) <> 0 then
begin begin
X := PwrToX(i / 100.0); X := PwrToX(i / 100.0);
VLine(X, PY1 - TICK_MED, PY1 - 1, CLR_TICK_GREEN); VLine(X, PY1 - TICK_MED * Sc, PY1 - Sc, CLR_TICK_GREEN);
end; end;
Inc(i, 5); Inc(i, 5);
end; end;
@@ -424,28 +436,28 @@ begin
for i := 0 to 4 do for i := 0 to 4 do
begin begin
X := PwrToX(PWR_MARKS[i]); X := PwrToX(PWR_MARKS[i]);
VLine(X, PY1 - TICK_LONG, PY1 - 1, CLR_TICK_WHITE); VLine(X, PY1 - TICK_LONG * Sc, PY1 - Sc, CLR_TICK_WHITE);
Lbl := Format('%.0f', [PWR_MARKS[i] * FPAMaxPower]); Lbl := Format('%.0f', [PWR_MARKS[i] * FPAMaxPower]);
TW := ACanvas.TextWidth(Lbl); TW := ACanvas.TextWidth(Lbl);
ACanvas.Font.Color := CLR_SCALE_DBM; ACanvas.Font.Color := CLR_SCALE_DBM;
ACanvas.TextOut(X - TW div 2, PY1 - TICK_LONG - ACanvas.TextHeight(Lbl) - 1, Lbl); ACanvas.TextOut(X - TW div 2, PY1 - TICK_LONG * Sc - ACanvas.TextHeight(Lbl) - Sc, Lbl);
end; end;
for i := 2 to 9 do for i := 2 to 9 do
begin begin
if i = 5 then Continue; if i = 5 then Continue;
X := SWRToX(i); X := SWRToX(i);
if i >= 3 then VLine(X, SY2 + 1, SY2 + TICK_MED, CLR_TICK_BLUE) if i >= 3 then VLine(X, SY2 + Sc, SY2 + TICK_MED * Sc, CLR_TICK_BLUE)
else VLine(X, SY2 + 1, SY2 + TICK_MED, CLR_TICK_GREEN); else VLine(X, SY2 + Sc, SY2 + TICK_MED * Sc, CLR_TICK_GREEN);
end; end;
for i := 0 to 3 do for i := 0 to 3 do
begin begin
X := SWRToX(SWR_MARKS_VAL[i]); X := SWRToX(SWR_MARKS_VAL[i]);
if SWR_MARKS_VAL[i] >= SWR_HIGH_THRESH then if SWR_MARKS_VAL[i] >= SWR_HIGH_THRESH then
VLine(X, SY2 + 1, SY2 + TICK_LONG, CLR_TICK_BLUE) VLine(X, SY2 + Sc, SY2 + TICK_LONG * Sc, CLR_TICK_BLUE)
else else
VLine(X, SY2 + 1, SY2 + TICK_LONG, CLR_TICK_GREEN); VLine(X, SY2 + Sc, SY2 + TICK_LONG * Sc, CLR_TICK_GREEN);
Lbl := SWR_MARKS_LBL[i]; TW := ACanvas.TextWidth(Lbl); Lbl := SWR_MARKS_LBL[i]; TW := ACanvas.TextWidth(Lbl);
if SWR_MARKS_VAL[i] >= SWR_HIGH_THRESH then if SWR_MARKS_VAL[i] >= SWR_HIGH_THRESH then
begin begin
@@ -453,25 +465,25 @@ begin
else ACanvas.Font.Color := CLR_SCALE_S_BLUE; else ACanvas.Font.Color := CLR_SCALE_S_BLUE;
end else end else
ACanvas.Font.Color := CLR_SCALE_S_GREEN; ACanvas.Font.Color := CLR_SCALE_S_GREEN;
ACanvas.TextOut(X - TW div 2, SY2 + TICK_LONG + 1, Lbl); ACanvas.TextOut(X - TW div 2, SY2 + TICK_LONG * Sc + Sc, Lbl);
end; end;
ACanvas.Brush.Style := bsClear; ACanvas.Brush.Style := bsClear;
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0'); ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0');
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0'); ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0');
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM; ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM;
ACanvas.TextOut(LblZoneL + 4, PY1 - TH10 - 2, LblPwr); ACanvas.TextOut(LblZoneL + 4 * Sc, PY1 - TH10 - 2 * Sc, LblPwr);
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold];
if SWRHigh then ACanvas.Font.Color := CLR_SWR_HIGH if SWRHigh then ACanvas.Font.Color := CLR_SWR_HIGH
else ACanvas.Font.Color := CLR_LABEL_S; else ACanvas.Font.Color := CLR_LABEL_S;
ACanvas.TextOut(LblZoneL + 4, SY2 + 2, LblSWR); ACanvas.TextOut(LblZoneL + 4 * Sc, SY2 + 2 * Sc, LblSWR);
if SWRHigh then if SWRHigh then
begin begin
ACanvas.Font.Size := 6; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_SWR_HIGH; ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_SWR_HIGH;
ACanvas.TextOut(LblZoneL + 4 + TWPwr + 2, PY1 - TH6 - 4, 'SWR High'); ACanvas.TextOut(LblZoneL + 4 * Sc + TWPwr + 2 * Sc, PY1 - TH6 - 4 * Sc, 'SWR High');
end; end;
end; end;
@@ -480,28 +492,38 @@ end;
// ──────────────────────────────────────────────────────────────────────────── // ────────────────────────────────────────────────────────────────────────────
procedure TSMeterView.PaintSMeterRight(Sender: TObject); procedure TSMeterView.PaintSMeterRight(Sender: TObject);
var PB: TPaintBox; W, H, ZX1, ZX2, ZY1, ZY2: Integer; var PB: TPaintBox; W, H, BmpW, BmpH, ZX1, ZX2, ZY1, ZY2: Integer;
begin begin
PB := TPaintBox(Sender); PB := TPaintBox(Sender);
W := PB.Width; H := PB.Height; W := PB.Width; H := PB.Height;
if (W <= 0) or (H <= 0) then Exit; if (W <= 0) or (H <= 0) then Exit;
if (FSmBitmap = nil) or (FSmBitmap.Width <> W) or (FSmBitmap.Height <> H) then
// Битмап держим в физических пикселях канвы, иначе Cocoa растянет его вдвое
// и картинка замылится. На Windows/Linux FScale=1 и всё как было.
FScale := GetScreenScale;
BmpW := W * FScale; BmpH := H * FScale;
if (FSmBitmap = nil) or (FSmBitmap.Width <> BmpW) or (FSmBitmap.Height <> BmpH) then
begin begin
FreeAndNil(FSmBitmap); FreeAndNil(FSmBitmap);
FSmBitmap := TBitmap.Create; FSmBitmap := TBitmap.Create;
FSmBitmap.SetSize(W, H); FSmBitmap.SetSize(BmpW, BmpH);
end; end;
if FTransmitting then if FTransmitting then
begin begin
DrawTXMeter(FSmBitmap.Canvas, Rect(0, 0, W, H)); DrawTXMeter(FSmBitmap.Canvas, Rect(0, 0, BmpW, BmpH));
end else end else
begin begin
DrawSMeterWide(FSmBitmap.Canvas, Rect(0, 0, W, H), DrawSMeterWide(FSmBitmap.Canvas, Rect(0, 0, BmpW, BmpH),
FLastSMeter, FSMeterPeak, FSMeterMin, FLastSMeter, FSMeterPeak, FSMeterMin,
ZX1, ZX2, ZY1, ZY2); ZX1, ZX2, ZY1, ZY2);
DrawSMeterZone(FSmBitmap.Canvas, Rect(0, 0, W, H), ZX1, ZX2, ZY1, ZY2); DrawSMeterZone(FSmBitmap.Canvas, Rect(0, 0, BmpW, BmpH), ZX1, ZX2, ZY1, ZY2);
end; end;
PB.Canvas.Draw(0, 0, FSmBitmap);
if FScale = 1 then
PB.Canvas.Draw(0, 0, FSmBitmap)
else
PB.Canvas.StretchDraw(Rect(0, 0, W, H), FSmBitmap);
end; end;
end. end.