diff --git a/MacScale.pas b/MacScale.pas new file mode 100644 index 0000000..a316616 --- /dev/null +++ b/MacScale.pas @@ -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. diff --git a/PanZoomBar.pas b/PanZoomBar.pas index 5bc62e4..a4175b6 100644 --- a/PanZoomBar.pas +++ b/PanZoomBar.pas @@ -26,7 +26,7 @@ interface uses Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, - LCLIntf, LCLType, IntfGraphics, fpImage, AppTheme; + LCLIntf, LCLType, IntfGraphics, fpImage, AppTheme, PlatformUtils; type TPanZoomEvent = procedure(AZoom, APan: Double) of object; @@ -47,9 +47,14 @@ type FDragLo: Double; // зафиксированный левый край окна (для edge-зума), доля FDragHi: Double; // зафиксированный правый край окна, доля FOnZoomPan: TPanZoomEvent; + // Масштаб канвы: 2 на Retina, 1 на Windows/Linux. Только для отрисовки — + // мышь работает в логических координатах паинтбокса. + FScale: Integer; 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 EmitWindow(NewLo, NewHi: Double); // окно → zoom/pan + callback function EdgePx(Wd: Integer): Integer; @@ -109,6 +114,7 @@ begin FCenterFreq := 0.0; FSpanHz := 192000.0; FDragMode := dmNone; + FScale := 1; end; destructor TPanZoomBar.Destroy; @@ -162,13 +168,14 @@ begin Result := Max(3, Min(8, Wd div 3)); 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; begin Result := W > 0; if not Result then begin L := 0; Wd := 0; Exit; end; 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; L := Round(Lo * W); if L < 0 then L := 0; @@ -199,7 +206,9 @@ var i, X, TickMaj, TickMin, LabelY, NDiv, LabelEvery, TW: Integer; FreqStart, FreqHz, PixPerDiv: Double; Lbl: string; + Sc: Integer; // масштаб канвы, см. FScale begin + Sc := FScale; C := FBmp.Canvas; C.Brush.Style := bsSolid; C.Brush.Color := FTheme.SliderBG; @@ -207,11 +216,12 @@ begin C.Font.Name := 'Courier New'; 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.Pen.Width := Sc; - TickMaj := Max(3, Round(H * 0.28)); - TickMin := Max(2, Round(H * 0.16)); + TickMaj := Max(3 * Sc, Round(H * 0.28)); + TickMin := Max(2 * Sc, Round(H * 0.16)); LabelY := TickMaj + ((H - TickMaj) - C.TextHeight('0')) div 2; if LabelY < TickMaj then LabelY := TickMaj; @@ -219,14 +229,14 @@ begin if FSpanHz <= 0 then Exit; FreqStart := FCenterFreq - FSpanHz / 2; PixPerDiv := W / NDiv; - if PixPerDiv >= (C.TextWidth('000.000') + 8) then LabelEvery := 1 - else if PixPerDiv * 2 >= (C.TextWidth('000.000') + 8) then LabelEvery := 2 + if PixPerDiv >= (C.TextWidth('000.000') + 8 * Sc) then LabelEvery := 1 + else if PixPerDiv * 2 >= (C.TextWidth('000.000') + 8 * Sc) then LabelEvery := 2 else LabelEvery := 4; for i := 0 to NDiv do begin X := Round(i * PixPerDiv); - if X >= W then X := W - 1; + if X >= W then X := W - Sc; C.Pen.Color := FTheme.RulerBorder; if (i mod LabelEvery) = 0 then begin @@ -254,8 +264,10 @@ var tR, tG, tB, bgR, bgG, bgB, nR, nG, nB: Integer; A, RowT, Gloss: Double; Active: Boolean; + Sc: Integer; // масштаб канвы, см. FScale 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; if Active then begin @@ -270,8 +282,8 @@ begin tB := GetBValue(ColorToRGB(FTheme.SliderThumbNorm)); end; - top := 1; - bot := H - 2; + top := Sc; + bot := H - 2 * Sc; Intf := FBmp.CreateIntfImage; try for y := top to bot do @@ -299,47 +311,56 @@ begin // Объёмная фаска + маркеры краёв (две вертикальные риски — «ручки» ресайза). with FBmp.Canvas do begin - Pen.Width := 1; Brush.Style := bsClear; + Pen.Width := Sc; Brush.Style := bsClear; 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), EnsureRange(tG + 70, 0, 255), EnsureRange(tB + 70, 0, 255)); - MoveTo(L + 1, top + 1); LineTo(L + Wd - 1, top + 1); - MoveTo(L + 1, top + 1); LineTo(L + 1, bot); + MoveTo(L + Sc, top + Sc); LineTo(L + Wd - Sc, top + Sc); + MoveTo(L + Sc, top + Sc); LineTo(L + Sc, bot); Pen.Color := RGBToColor(EnsureRange(tR - 60, 0, 255), EnsureRange(tG - 60, 0, 255), EnsureRange(tB - 60, 0, 255)); - MoveTo(L + 1, bot); LineTo(L + Wd - 1, bot); - MoveTo(L + Wd - 1, top + 1); LineTo(L + Wd - 1, bot + 1); + MoveTo(L + Sc, bot); LineTo(L + Wd - Sc, bot); + 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 Pen.Color := FTheme.SliderThumbBdr; - MoveTo(L + 3, top + 2); LineTo(L + 3, bot - 1); - MoveTo(L + Wd - 4, top + 2); LineTo(L + Wd - 4, bot - 1); + MoveTo(L + 3 * Sc, top + 2 * Sc); LineTo(L + 3 * Sc, bot - Sc); + MoveTo(L + Wd - 4 * Sc, top + 2 * Sc); LineTo(L + Wd - 4 * Sc, bot - Sc); end; Brush.Style := bsSolid; end; end; procedure TPanZoomBar.Paint(Sender: TObject); -var W, H, L, Wd: Integer; +var W, H, BmpW, BmpH, L, Wd: Integer; begin if FPb = nil then Exit; W := FPb.Width; H := FPb.Height; if (W <= 0) or (H <= 0) then Exit; - if (FBmp.Width <> W) or (FBmp.Height <> H) then FBmp.SetSize(W, H); - DrawRulerInto(W, H); - if ThumbGeom(W, L, Wd) then BlendThumb(L, Wd, W, H); + // Битмап в физических пикселях канвы, иначе Cocoa растянет его и замылит. + 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.Pen.Width := FScale; 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; - 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; procedure TPanZoomBar.HandleMouseDown(Button: TMouseButton; X, Y: Integer); diff --git a/PlatformUtils.pas b/PlatformUtils.pas index c12d962..c4e5b2c 100644 --- a/PlatformUtils.pas +++ b/PlatformUtils.pas @@ -12,6 +12,9 @@ interface function HasOpenGLSpectrumSwitch: Boolean; function CurrentScreenDPI: Integer; +// Целочисленный масштаб канвы экрана: 2 на Retina, 1 везде остальном. +// Windows/Linux всегда получают 1 ⇒ умножение на него ничего не меняет. +function GetScreenScale: Integer; // Возвращает каталог для хранения конфигурации (с завершающим разделителем). // macOS: ~/Library/Application Support/ewsdr/ // Linux: ~/.config/ewsdr/ @@ -21,7 +24,8 @@ function GetAppCfgDir: string; implementation uses - SysUtils {$IFNDEF HEADLESS}, Forms{$ENDIF}; + SysUtils {$IFNDEF HEADLESS}, Forms{$ENDIF} + {$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}, MacScale{$ENDIF}; function HasOpenGLSpectrumSwitch: Boolean; var @@ -42,6 +46,17 @@ begin 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; + function CurrentScreenDPI: Integer; begin {$IFNDEF HEADLESS} diff --git a/RulerView.pas b/RulerView.pas index f1b7285..264b527 100644 --- a/RulerView.pas +++ b/RulerView.pas @@ -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. diff --git a/SMeterView.pas b/SMeterView.pas index 8bf1b63..ab67702 100644 --- a/SMeterView.pas +++ b/SMeterView.pas @@ -13,7 +13,7 @@ interface uses Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, - IntfGraphics, FPImage, LCLType, GraphType, AppTheme; + IntfGraphics, FPImage, LCLType, GraphType, AppTheme, PlatformUtils; const SM_CLR_METER_ON = TColor($0000CC44); @@ -32,6 +32,9 @@ type FPAMaxPower: Double; FTransmitting: Boolean; FPbSMeterRight: TPaintBox; + // Масштаб канвы: 2 на Retina, 1 на Windows/Linux. Битмап растёт во столько + // же раз, пиксельные константы и шрифты умножаются на него. + FScale: Integer; procedure DrawSMeterWide(ACanvas: TCanvas; R: TRect; Value, Peak, MinVal: Double; @@ -74,6 +77,7 @@ begin FLastSWR := 1; FPAMaxPower := 100.0; FTransmitting := False; + FScale := 1; end; destructor TSMeterView.Destroy; @@ -112,6 +116,7 @@ var i, X, TW: Integer; Lbl: string; SNum, Over: Integer; LblDbm, LblS: string; TWDbm, LblZoneL, TH10, TH6, MaxTWDbm, MaxTWS, LabelNeed: Integer; + Sc: Integer; // масштаб канвы, см. FScale function DBtoX(dB: Double): Integer; inline; begin @@ -146,9 +151,10 @@ begin CLR_SCALE_S_BLUE := FTheme.SMeterScaleSBlue; CLR_BDR := FTheme.SMeterBdr; + Sc := FScale; W := R.Right - R.Left; H := R.Bottom - R.Top; 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]); if Value >= -73.0 then @@ -164,14 +170,14 @@ begin end; 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'); MaxTWS := ACanvas.TextWidth('S9+60'); - ACanvas.Font.Size := 6; ACanvas.Font.Style := []; - LabelNeed := Max(MaxTWDbm + 2 + ACanvas.TextWidth('dBm '), MaxTWS) + LABEL_PAD * 2; - LeftInfo := Max(LEFT_INFO_MIN, LabelNeed + 4); - BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD; - if BW < 10 then Exit; + ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; + LabelNeed := Max(MaxTWDbm + 2 * Sc + ACanvas.TextWidth('dBm '), MaxTWS) + LABEL_PAD * 2 * Sc; + LeftInfo := Max(LEFT_INFO_MIN * Sc, LabelNeed + 4 * Sc); + BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD * Sc; + if BW < 10 * Sc then Exit; LblZoneL := BX - LabelNeed; 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.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(S9X, Y_BAR_TOP, OvrX, Y_BAR_BOT, CLR_BAR_GREEN); FillBar(OvrX, Y_BAR_TOP, BX + BW, Y_BAR_BOT, CLR_BAR_OVER); @@ -189,65 +197,65 @@ begin PeakRight := DBtoX(Peak); ZX1 := Max(BX + 1, Min(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 begin 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 - FillBar(BX, Y_BAR_TOP+1, S9X, Y_BAR_BOT-1, CLR_BAR_GREEN); - FillBar(S9X, Y_BAR_TOP+1, BarEnd, Y_BAR_BOT-1, CLR_BAR_OVER); + FillBar(BX, Y_BAR_TOP+Sc, S9X, Y_BAR_BOT-Sc, CLR_BAR_GREEN); + FillBar(S9X, Y_BAR_TOP+Sc, BarEnd, Y_BAR_BOT-Sc, CLR_BAR_OVER); end; end; if (PeakRight > BX) and (PeakRight <= BX + BW) then 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.LineTo(PeakRight, Y_BAR_BOT + (Y_BAR_BOT - Y_BAR_TOP)); - ACanvas.Pen.Width := 1; + ACanvas.Pen.Width := Sc; end; ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := CLR_BDR; ACanvas.Rectangle(LblZoneL, Y_BAR_TOP, BX + BW, Y_BAR_BOT); 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 begin 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); 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; i := -125; while i < -13 do 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); end; for i := 0 to High(S_MARKS_DBM) do begin 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) - else VLine(X, Y_BAR_BOT+1, Y_BAR_BOT+TICK_LONG, CLR_TICK_GREEN); + 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+Sc, Y_BAR_BOT+TICK_LONG*Sc, CLR_TICK_GREEN); Lbl := S_MARKS_LBL[i]; TW := ACanvas.TextWidth(Lbl); if S_MARKS_DBM[i] >= DB_S9 then ACanvas.Font.Color := CLR_SCALE_S_BLUE 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; ACanvas.Brush.Style := bsClear; - ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0'); - ACanvas.Font.Size := 6; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0'); - ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM; - ACanvas.TextOut(LblZoneL + 4, Y_BAR_TOP - TH10 - 2, LblDbm); - ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Font.Color := CLR_TICK_BLUE; - ACanvas.TextOut(LblZoneL + 4 + TWDbm + 2, Y_BAR_TOP - TH6 - 4, 'dBm'); - ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_S; - ACanvas.TextOut(LblZoneL + 4, Y_BAR_BOT + 2, LblS); + ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0'); + ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0'); + ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM; + ACanvas.TextOut(LblZoneL + 4 * Sc, Y_BAR_TOP - TH10 - 2 * Sc, LblDbm); + ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; ACanvas.Font.Color := CLR_TICK_BLUE; + ACanvas.TextOut(LblZoneL + 4 * Sc + TWDbm + 2 * Sc, Y_BAR_TOP - TH6 - 4 * Sc, 'dBm'); + ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_S; + ACanvas.TextOut(LblZoneL + 4 * Sc, Y_BAR_BOT + 2 * Sc, LblS); end; // ──────────────────────────────────────────────────────────────────────────── @@ -300,6 +308,7 @@ var PBarEnd, SBarEnd, S_WarnX: Integer; LblPwr, LblSWR: string; TWPwr, LblZoneL, TH10, TH6, MaxTWPwr, MaxTWSWR, LabelNeed: Integer; + Sc: Integer; // масштаб канвы, см. FScale i, X, TW: Integer; Lbl: string; SWRHigh: Boolean; @@ -345,23 +354,24 @@ begin CLR_BDR := FTheme.SMeterBdr; CLR_SWR_HIGH := TColor($000000CC); + Sc := FScale; 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; LblPwr := Format('%.0fW', [FLastFwdW]); LblSWR := Format('SWR:%.1f', [FLastSWR]); ACanvas.Font.Name := 'Courier New'; ACanvas.Font.Style := [fsBold]; - ACanvas.Font.Size := 10; + ACanvas.Font.Size := 10 * Sc; TWPwr := ACanvas.TextWidth(LblPwr); MaxTWPwr := ACanvas.TextWidth(Format('%.0fW', [FPAMaxPower])); MaxTWSWR := ACanvas.TextWidth('SWR:10.0'); - ACanvas.Font.Size := 6; ACanvas.Font.Style := []; - LabelNeed := Max(MaxTWPwr, MaxTWSWR) + LABEL_PAD * 2; - LeftInfo := Max(LEFT_INFO_MIN, LabelNeed + 4); - BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD; - if BW < 10 then Exit; + ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := []; + LabelNeed := Max(MaxTWPwr, MaxTWSWR) + LABEL_PAD * 2 * Sc; + LeftInfo := Max(LEFT_INFO_MIN * Sc, LabelNeed + 4 * Sc); + BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD * Sc; + if BW < 10 * Sc then Exit; LblZoneL := BX - LabelNeed; 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; PY1 := Y_BAR_TOP; - PY2 := Y_BAR_MID - 1; - SY1 := Y_BAR_MID + 1; + PY2 := Y_BAR_MID - Sc; + SY1 := Y_BAR_MID + Sc; SY2 := Y_BAR_BOT; S_WarnX := SWRToX(SWR_HIGH_THRESH); ACanvas.Brush.Color := CLR_SMETER_BG; ACanvas.Brush.Style := bsSolid; 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, SY1, S_WarnX, SY2, CLR_BAR_GREEN); @@ -384,16 +396,16 @@ begin if FPAMaxPower > 0 then PwrPct := FLastFwdW / FPAMaxPower else PwrPct := 0; 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); 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 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 - FillBar(S_WarnX, SY1 + 1, SBarEnd, SY2 - 1, CLR_SWR_HIGH); + FillBar(S_WarnX, SY1 + Sc, SBarEnd, SY2 - Sc, CLR_SWR_HIGH); end; VLine(S_WarnX, SY1, SY2, FTheme.SMeterDivider); @@ -405,10 +417,10 @@ begin ACanvas.Rectangle(LblZoneL, SY1, BX + BW, SY2); ACanvas.Pen.Color := FTheme.SMeterDivider; - ACanvas.MoveTo(BX, PY1 + 1); ACanvas.LineTo(BX, PY2 - 1); - ACanvas.MoveTo(BX, SY1 + 1); ACanvas.LineTo(BX, SY2 - 1); + ACanvas.MoveTo(BX, PY1 + Sc); ACanvas.LineTo(BX, PY2 - Sc); + 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; while i < 100 do @@ -416,7 +428,7 @@ begin if (i mod 25) <> 0 then begin 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; Inc(i, 5); end; @@ -424,28 +436,28 @@ begin for i := 0 to 4 do begin 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]); TW := ACanvas.TextWidth(Lbl); 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; for i := 2 to 9 do begin if i = 5 then Continue; X := SWRToX(i); - if i >= 3 then VLine(X, SY2 + 1, SY2 + TICK_MED, CLR_TICK_BLUE) - else VLine(X, SY2 + 1, SY2 + TICK_MED, CLR_TICK_GREEN); + if i >= 3 then VLine(X, SY2 + Sc, SY2 + TICK_MED * Sc, CLR_TICK_BLUE) + else VLine(X, SY2 + Sc, SY2 + TICK_MED * Sc, CLR_TICK_GREEN); end; for i := 0 to 3 do begin X := SWRToX(SWR_MARKS_VAL[i]); 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 - 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); if SWR_MARKS_VAL[i] >= SWR_HIGH_THRESH then begin @@ -453,25 +465,25 @@ begin else ACanvas.Font.Color := CLR_SCALE_S_BLUE; end else 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; ACanvas.Brush.Style := bsClear; - ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0'); - ACanvas.Font.Size := 6; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0'); + ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; TH10 := 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.TextOut(LblZoneL + 4, PY1 - TH10 - 2, LblPwr); + ACanvas.Font.Size := 10 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM; + 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 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 begin - ACanvas.Font.Size := 6; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_SWR_HIGH; - ACanvas.TextOut(LblZoneL + 4 + TWPwr + 2, PY1 - TH6 - 4, 'SWR High'); + ACanvas.Font.Size := 6 * Sc; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_SWR_HIGH; + ACanvas.TextOut(LblZoneL + 4 * Sc + TWPwr + 2 * Sc, PY1 - TH6 - 4 * Sc, 'SWR High'); end; end; @@ -480,28 +492,38 @@ end; // ──────────────────────────────────────────────────────────────────────────── 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 PB := TPaintBox(Sender); W := PB.Width; H := PB.Height; 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 FreeAndNil(FSmBitmap); FSmBitmap := TBitmap.Create; - FSmBitmap.SetSize(W, H); + FSmBitmap.SetSize(BmpW, BmpH); end; if FTransmitting then begin - DrawTXMeter(FSmBitmap.Canvas, Rect(0, 0, W, H)); + DrawTXMeter(FSmBitmap.Canvas, Rect(0, 0, BmpW, BmpH)); end else begin - DrawSMeterWide(FSmBitmap.Canvas, Rect(0, 0, W, H), + DrawSMeterWide(FSmBitmap.Canvas, Rect(0, 0, BmpW, BmpH), FLastSMeter, FSMeterPeak, FSMeterMin, 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; - 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.