unit RulerView; { RulerView.pas — рендеринг линейки частот под спектром/водопадом. TRulerView — изолированный класс, не зависит от SpectrumView. } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, LCLIntf, LCLType, AppTheme; type TRulerView = class private FRulerBitmap: TBitmap; 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; 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, H); 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; begin if FPbRuler = nil then Exit; W := FPbRuler.Width; H := FPbRuler.Height; 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 := 1; C.MoveTo(0, 0); C.LineTo(W, 0); C.MoveTo(0, H-1); C.LineTo(W, H-1); // Высота шрифта привязана к высоте линейки (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.Brush.Style := bsClear; // Короткие ticks сверху + метка по центру оставшейся области (по TextHeight), // чтобы цифры стояли по центру, а не уезжали вниз. TickMaj := Max(4, Round(H * 0.34)); TickMin := Max(2, 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) / 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; C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 1); C.Pen.Width := 1; end; end; // ──────────────────────────────────────────────────────────────────────────── // PaintRuler // ──────────────────────────────────────────────────────────────────────────── procedure TRulerView.PaintRuler(Sender: TObject); var PB: TPaintBox; begin PB := TPaintBox(Sender); DrawRuler; if (FRulerBitmap.Width > 0) and (FRulerBitmap.Height > 0) then PB.Canvas.Draw(0, 0, FRulerBitmap); end; end.