ewsdr/RulerView.pas

unit RulerView;

{
  RulerView.pas — рендеринг линейки частот под спектром/водопадом.
  TRulerView — изолированный класс, не зависит от SpectrumView.
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
  LCLIntf, LCLType, AppTheme, PlatformUtils;

type
  TRulerView = class
  private
    FRulerBitmap:    TBitmap;
    // Масштаб канвы: 2 на Retina, 1 на Windows/Linux.
    FScale:          Integer;
    FRulerLastFreq:  Double;
    FRulerLastVfo:   Double;
    FRulerLastSpan:  Double;
    FVfoA:           Double;
    FVfoB:           Double;
    FActiveVfo:      Integer;
    FCenterFreq:     Double;
    FSpanHz:         Double;
    FFMGridStepHz:   Double;
    FTheme:          TAppTheme;
    FPbRuler:        TPaintBox;

    function  ActiveVfoFreq: Double;
    function  ScaleX(X, Total, Width: Integer): Integer;
  public
    constructor Create;
    destructor  Destroy; override;

    property VfoA:         Double  read FVfoA         write FVfoA;
    property VfoB:         Double  read FVfoB         write FVfoB;
    property ActiveVfo:    Integer read FActiveVfo    write FActiveVfo;
    property CenterFreq:   Double  read FCenterFreq   write FCenterFreq;
    property SpanHz:       Double  read FSpanHz       write FSpanHz;
    property FMGridStepHz: Double  read FFMGridStepHz write FFMGridStepHz;
    property PbRuler:      TPaintBox write FPbRuler;

    procedure DrawRuler;
    procedure PaintRuler(Sender: TObject);
    procedure SetRulerSize(W, H: Integer);
    procedure InvalidateRulerCache;
    function  NeedsRulerRedraw: Boolean;
    procedure SetTheme(const T: TAppTheme);
  end;

implementation

// ════════════════════════════════════════════════════════════════════════════
// Вспомогательные функции (приватные копии)
// ════════════════════════════════════════════════════════════════════════════

function FormatFreqRuler(Hz: Double): string;
var Mhz: Int64; KHz, Rest: Integer;
begin
  Mhz  := Trunc(Hz / 1000000);
  KHz  := Trunc((Hz - Mhz * 1000000) / 1000);
  Rest := Trunc(Hz) mod 1000;
  Result := Format('%d.%3.3d.%3.3d', [Mhz, KHz, Rest]);
end;

function MixColorBGRR(C1, C2: TColor; T: Double): TColor;
var
  B1, G1, R1, B2, G2, R2, B, G, R: Integer;
begin
  if T < 0.0 then T := 0.0 else if T > 1.0 then T := 1.0;
  B1 := (C1 shr 16) and $FF; G1 := (C1 shr 8) and $FF; R1 := C1 and $FF;
  B2 := (C2 shr 16) and $FF; G2 := (C2 shr 8) and $FF; R2 := C2 and $FF;
  B := Round(B1 + (B2-B1)*T); G := Round(G1 + (G2-G1)*T); R := Round(R1 + (R2-R1)*T);
  Result := TColor((B shl 16) or (G shl 8) or R);
end;

procedure PaintVerticalGradientR(C: TCanvas; W, H: Integer; TopColor, BottomColor: TColor);
var Y: Integer; T: Double;
begin
  if (W <= 0) or (H <= 0) then Exit;
  C.Pen.Style := psClear; C.Brush.Style := bsSolid;
  for Y := 0 to H - 1 do
  begin
    T := Y / Max(1, H - 1);
    C.Brush.Color := MixColorBGRR(TopColor, BottomColor, T);
    C.FillRect(Rect(0, Y, W, Y + 1));
  end;
  C.Pen.Style := psSolid;
end;

// ════════════════════════════════════════════════════════════════════════════
// TRulerView
// ════════════════════════════════════════════════════════════════════════════

constructor TRulerView.Create;
begin
  inherited Create;
  FRulerBitmap   := TBitmap.Create;
  FRulerLastFreq := -1.0;
  FRulerLastVfo  := -1.0;
  FRulerLastSpan := -1.0;
  FTheme         := DarkTheme;
  FSpanHz        := 192000;
  FScale         := 1;
end;

destructor TRulerView.Destroy;
begin
  FRulerBitmap.Free;
  inherited;
end;

function TRulerView.ActiveVfoFreq: Double;
begin
  if FActiveVfo = 0 then Result := FVfoA else Result := FVfoB;
end;

function TRulerView.ScaleX(X, Total, Width: Integer): Integer;
begin
  if Total = 0 then Result := 0
  else Result := Round(X / Total * Width);
end;

procedure TRulerView.SetTheme(const T: TAppTheme);
begin
  FTheme := T;
  InvalidateRulerCache;
end;

procedure TRulerView.SetRulerSize(W, H: Integer);
begin
  if (W <= 0) or (H <= 0) then Exit;
  FRulerBitmap.SetSize(W * FScale, H * FScale);
  InvalidateRulerCache;
end;

procedure TRulerView.InvalidateRulerCache;
begin
  FRulerLastFreq := -1.0;
  FRulerLastVfo  := -1.0;
  FRulerLastSpan := -1.0;
end;

function TRulerView.NeedsRulerRedraw: Boolean;
begin
  Result := (Abs(FCenterFreq - FRulerLastFreq) >= 0.5) or
            (Abs(ActiveVfoFreq - FRulerLastVfo) >= 0.5) or
            (Abs(FSpanHz - FRulerLastSpan) >= 1.0);
end;

// ────────────────────────────────────────────────────────────────────────────
// DrawRuler
// ────────────────────────────────────────────────────────────────────────────

procedure TRulerView.DrawRuler;
var
  C: TCanvas; W, H, i, X: Integer;
  FreqStart, FreqHz, GridLine, pixPerStep: Double; VfoX: Integer;
  Lbl: string; TW: Integer;
  N, labelMult: Integer;
  TickMaj, TickMin, LabelY: Integer;
  Sc: Integer;   // масштаб канвы, см. FScale
begin
  if FPbRuler = nil then Exit;
  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
     (Abs(FSpanHz - FRulerLastSpan) < 1.0) then Exit;
  FRulerLastFreq := FCenterFreq; FRulerLastVfo := ActiveVfoFreq; FRulerLastSpan := FSpanHz;
  if (FRulerBitmap.Width <> W) or (FRulerBitmap.Height <> H) then
    FRulerBitmap.SetSize(W, H);
  C := FRulerBitmap.Canvas;
  PaintVerticalGradientR(C, W, H, FTheme.RulerGradTop, FTheme.RulerGradBot);
  C.Pen.Color := FTheme.RulerBorder; C.Pen.Width := Sc;
  C.MoveTo(0, 0); C.LineTo(W, 0);
  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 * Sc, Round(H * 0.42));
  C.Brush.Style := bsClear;
  // Короткие ticks сверху + метка по центру оставшейся области (по TextHeight),
  // чтобы цифры стояли по центру, а не уезжали вниз.
  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;
  if FFMGridStepHz > 0 then
  begin
    pixPerStep := W * FFMGridStepHz / FSpanHz;
    if pixPerStep >= 1.0 then
      labelMult := Max(1, Ceil((C.TextWidth('000.000') + 6 * Sc) / pixPerStep))
    else
      labelMult := MaxInt;
    N := Ceil(FreqStart / FFMGridStepHz);
    GridLine := N * FFMGridStepHz;
    while GridLine <= FCenterFreq + FSpanHz / 2 + 0.5 do
    begin
      X := Round((GridLine - FreqStart) / FSpanHz * W);
      if (X >= 0) and (X < W) then
      begin
        C.Pen.Color := FTheme.RulerBorder;
        if (N mod labelMult) = 0 then
        begin
          C.MoveTo(X, 0); C.LineTo(X, TickMaj);
          Lbl := Format('%.3f', [GridLine / 1e6]);
          TW  := C.TextWidth(Lbl);
          C.Font.Color := FTheme.RulerText;
          C.TextOut(X - TW div 2, LabelY, Lbl);
        end else
        begin
          C.MoveTo(X, 0); C.LineTo(X, TickMin);
        end;
      end;
      Inc(N);
      GridLine := GridLine + FFMGridStepHz;
    end;
  end else
  begin
    for i := 0 to 8 do
    begin
      X := ScaleX(i, 8, W);
      C.Pen.Color := FTheme.RulerBorder;
      C.MoveTo(X, 0); C.LineTo(X, TickMaj);
      FreqHz := FreqStart + i * FSpanHz / 8;
      Lbl := Format('%.3f', [FreqHz / 1e6]);
      TW  := C.TextWidth(Lbl);
      C.Font.Color := FTheme.RulerText;
      C.TextOut(X - TW div 2, LabelY, Lbl);
    end;
  end;
  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 * Sc;
    C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - Sc); C.Pen.Width := Sc;
  end;
end;

// ────────────────────────────────────────────────────────────────────────────
// PaintRuler
// ────────────────────────────────────────────────────────────────────────────

procedure TRulerView.PaintRuler(Sender: TObject);
var PB: TPaintBox; NewScale: Integer;
begin
  PB := TPaintBox(Sender);

  // Окно могли перетащить на монитор с другим масштабом — кэш линейки тогда
  // держит битмап прежнего разрешения, его надо выбросить.
  NewScale := GetControlScale(PB);
  if NewScale <> FScale then
  begin
    FScale := NewScale;
    InvalidateRulerCache;
  end;

  DrawRuler;
  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.