ewsdr/PanZoomBar.pas

unit PanZoomBar;

{
  PanZoomBar.pas — нижняя панель пана/зума спектра и водопада.

  Полоса = мини-линейка ПОЛНОГО диапазона (sample rate): цифры частот + деления.
  Поверх — окно-селектор «стекло» (полупрозрачное, с объёмной фаской), равное
  видимой полосе. Взаимодействие:
    • тянешь СЕРЕДИНУ окна  → пан (сдвиг видимой полосы);
    • тянешь ЛЕВЫЙ/ПРАВЫЙ край → зум (меняешь ширину окна, противоположный край
      зафиксирован), курсор у края ⇔;
    • клик мимо окна        → окно центрируется на курсоре (пан);
    • двойной клик          → сброс к полному диапазону (зум 0).
  Сквозь стекло видны цифры/деления. Callback OnZoomPan(zoom, pan) отдаёт обе
  величины (зум 0..1, пан 0..1) — контроллер применяет их напрямую.

  Рисует в чужой TPaintBox (как RulerView) через offscreen-битмап. Полупрозрачность
  стекла — реальный per-pixel альфа-бленд (TLazIntfImage). Кнопки +/умолч/- — в MainForm.
}

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

interface

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

type
  TPanZoomEvent = procedure(AZoom, APan: Double) of object;

  TDragMode = (dmNone, dmBody, dmLeft, dmRight);

  TPanZoomBar = class
  private
    FPb:          TPaintBox;
    FBmp:         TBitmap;
    FTheme:       TAppTheme;
    FZoom:        Double;     // 0..1 (0 = без зума, весь span виден)
    FPan:         Double;     // 0..1 (положение окна по span)
    FCenterFreq:  Double;     // центр ПОЛНОГО диапазона (DDC), Гц
    FSpanHz:      Double;     // полный span (= sample rate), Гц
    FDragMode:    TDragMode;
    FDragGrab:    Double;     // body: (курсор_доля − левый_край_доля) в момент захвата
    FDragLo:      Double;     // зафиксированный левый край окна (для edge-зума), доля
    FDragHi:      Double;     // зафиксированный правый край окна, доля
    FOnZoomPan:   TPanZoomEvent;
    // Масштаб канвы: 2 на Retina, 1 на Windows/Linux. Только для отрисовки —
    // мышь работает в логических координатах паинтбокса.
    FScale:       Integer;

    function  VisFraction: Double;          // доля span, видимая при текущем зуме
    // 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;
    procedure DrawRulerInto(W, H: Integer);
    procedure BlendThumb(L, Wd, W, H: Integer);
  public
    constructor Create;
    destructor  Destroy; override;

    property PaintBox: TPaintBox        write FPb;
    property OnZoomPan: TPanZoomEvent read FOnZoomPan write FOnZoomPan;

    procedure SetState(AZoom, APan: Double);
    procedure SetFreq(ACenterFreq, ASpanHz: Double);
    procedure SetTheme(const T: TAppTheme);
    procedure Paint(Sender: TObject);
    procedure HandleMouseDown(Button: TMouseButton; X, Y: Integer);
    procedure HandleMouseMove(X, Y: Integer);
    procedure HandleMouseUp;
    procedure HandleDblClick;
  end;

implementation

const
  MIN_THUMB_PX = 12;    // окно не уже этого на экране — чтобы было за что схватить
  MIN_VIS      = 0.01;  // минимальная видимая доля (= максимальный зум ~100x)

// Линейная интерполяция байт-канала.
function MixB(Bg, Fg: Integer; A: Double): Integer; inline;
begin
  Result := Round(Bg * (1.0 - A) + Fg * A);
  if Result < 0 then Result := 0 else if Result > 255 then Result := 255;
end;

function FreqLabel(Hz: Double): string;
begin
  Result := Format('%.3f', [Hz / 1e6]);
end;

// Видимая доля → коэффициент зума z (инверсия формулы анализатора).
function VisToZoom(Vis: Double): Double;
var V: Double;
begin
  V := EnsureRange(Vis, MIN_VIS, 1.0);
  Result := EnsureRange((Power(10.0, (1.0 - V) / 0.99) - 1.0) / 9.0, 0.0, 1.0);
end;

constructor TPanZoomBar.Create;
begin
  inherited Create;
  FBmp        := TBitmap.Create;
  FBmp.PixelFormat := pf32bit;
  FTheme      := DarkTheme;
  FZoom       := 0.0;
  FPan        := 0.5;
  FCenterFreq := 0.0;
  FSpanHz     := 192000.0;
  FDragMode   := dmNone;
  FScale      := 1;
end;

destructor TPanZoomBar.Destroy;
begin
  FBmp.Free;
  inherited;
end;

procedure TPanZoomBar.SetTheme(const T: TAppTheme);
begin
  FTheme := T;
  if Assigned(FPb) then FPb.Invalidate;
end;

procedure TPanZoomBar.SetState(AZoom, APan: Double);
var NewZoom, NewPan: Double;
begin
  NewZoom := EnsureRange(AZoom, 0.0, 1.0);
  NewPan  := EnsureRange(APan, 0.0, 1.0);
  if (Abs(NewZoom - FZoom) < 1e-4) and (Abs(NewPan - FPan) < 1e-4) then Exit;
  FZoom := NewZoom;
  FPan  := NewPan;
  if Assigned(FPb) then FPb.Invalidate;
end;

procedure TPanZoomBar.SetFreq(ACenterFreq, ASpanHz: Double);
begin
  if (Abs(ACenterFreq - FCenterFreq) < 0.5) and (Abs(ASpanHz - FSpanHz) < 1.0) then Exit;
  FCenterFreq := ACenterFreq;
  FSpanHz     := ASpanHz;
  if Assigned(FPb) then FPb.Invalidate;
end;

function TPanZoomBar.VisFraction: Double;
// Та же формула, что и span-clip в WDSPEngine: видимая доля = width/bins.
begin
  Result := EnsureRange(1.0 - 0.99 * Log10(9.0 * FZoom + 1.0), MIN_VIS, 1.0);
end;

procedure TPanZoomBar.CurWindow(out Lo, Hi: Double);
var Vis: Double;
begin
  Vis := VisFraction;
  Lo  := EnsureRange(FPan, 0.0, 1.0) * (1.0 - Vis);
  Hi  := Lo + Vis;
end;

function TPanZoomBar.EdgePx(Wd: Integer): Integer;
// Зона захвата края — узкая, но не съедает всё узкое окно (оставляем тело).
begin
  Result := Max(3, Min(8, Wd div 3));
end;

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 * AScale, Round((Hi - Lo) * W));
  if Wd > W then Wd := W;
  L  := Round(Lo * W);
  if L < 0 then L := 0;
  if L + Wd > W then L := W - Wd;
end;

procedure TPanZoomBar.EmitWindow(NewLo, NewHi: Double);
var Vis, Z, P: Double;
begin
  if NewLo < 0.0 then NewLo := 0.0;
  if NewHi > 1.0 then NewHi := 1.0;
  if NewHi - NewLo < MIN_VIS then NewHi := NewLo + MIN_VIS;
  if NewHi > 1.0 then begin NewHi := 1.0; NewLo := NewHi - MIN_VIS; end;
  Vis := NewHi - NewLo;
  Z   := VisToZoom(Vis);
  if (1.0 - Vis) > 1e-6 then P := NewLo / (1.0 - Vis) else P := 0.5;
  P := EnsureRange(P, 0.0, 1.0);
  // Локально обновляем сразу — драг плавный даже до round-trip контроллера.
  FZoom := Z; FPan := P;
  if Assigned(FPb) then FPb.Invalidate;
  if Assigned(FOnZoomPan) then FOnZoomPan(Z, P);
end;

procedure TPanZoomBar.DrawRulerInto(W, H: Integer);
// Цифры частот + деления на всю ширину (= полный диапазон).
var
  C: TCanvas;
  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;
  C.FillRect(Rect(0, 0, W, H));

  C.Font.Name   := 'Courier New';
  C.Font.Style  := [];
  C.Font.Height := -Max(7 * Sc, Round(H * 0.40));
  C.Brush.Style := bsClear;
  C.Pen.Width   := Sc;

  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;

  NDiv := 8;
  if FSpanHz <= 0 then Exit;
  FreqStart := FCenterFreq - FSpanHz / 2;
  PixPerDiv := W / NDiv;
  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 - Sc;
    C.Pen.Color := FTheme.RulerBorder;
    if (i mod LabelEvery) = 0 then
    begin
      C.MoveTo(X, 0); C.LineTo(X, TickMaj);
      FreqHz := FreqStart + i * FSpanHz / NDiv;
      Lbl := FreqLabel(FreqHz);
      TW  := C.TextWidth(Lbl);
      C.Font.Color := FTheme.RulerText;
      C.TextOut(EnsureRange(X - TW div 2, 0, W - TW), LabelY, Lbl);
    end
    else
    begin
      C.MoveTo(X, 0); C.LineTo(X, TickMin);
    end;
  end;
  C.Brush.Style := bsSolid;
end;

procedure TPanZoomBar.BlendThumb(L, Wd, W, H: Integer);
// Полупрозрачное «стекло» с объёмной фаской поверх линейки.
var
  Intf: TLazIntfImage;
  x, y, top, bot: Integer;
  c: TFPColor;
  tR, tG, tB, bgR, bgG, bgB, nR, nG, nB: Integer;
  A, RowT, Gloss: Double;
  Active: Boolean;
  Sc: Integer;   // масштаб канвы, см. FScale
begin
  Sc := FScale;
  if (Wd <= 0) or (W <= 0) or (H <= 2 * Sc) then Exit;
  Active := FDragMode <> dmNone;
  if Active then
  begin
    tR := GetRValue(ColorToRGB(FTheme.SliderThumbDrag));
    tG := GetGValue(ColorToRGB(FTheme.SliderThumbDrag));
    tB := GetBValue(ColorToRGB(FTheme.SliderThumbDrag));
  end
  else
  begin
    tR := GetRValue(ColorToRGB(FTheme.SliderThumbNorm));
    tG := GetGValue(ColorToRGB(FTheme.SliderThumbNorm));
    tB := GetBValue(ColorToRGB(FTheme.SliderThumbNorm));
  end;

  top := Sc;
  bot := H - 2 * Sc;
  Intf := FBmp.CreateIntfImage;
  try
    for y := top to bot do
    begin
      if (bot - top) > 0 then RowT := (y - top) / (bot - top) else RowT := 0.0;
      Gloss := 1.18 - 0.42 * RowT;                 // объём: ярче вверху, темнее внизу
      A := 0.42 + 0.10 * (1.0 - RowT);
      for x := L to L + Wd - 1 do
      begin
        if (x < 0) or (x >= W) then Continue;
        c := Intf.Colors[x, y];
        bgR := c.red shr 8; bgG := c.green shr 8; bgB := c.blue shr 8;
        nR := MixB(bgR, EnsureRange(Round(tR * Gloss), 0, 255), A);
        nG := MixB(bgG, EnsureRange(Round(tG * Gloss), 0, 255), A);
        nB := MixB(bgB, EnsureRange(Round(tB * Gloss), 0, 255), A);
        c.red := nR * 257; c.green := nG * 257; c.blue := nB * 257; c.alpha := $FFFF;
        Intf.Colors[x, y] := c;
      end;
    end;
    FBmp.LoadFromIntfImage(Intf);
  finally
    Intf.Free;
  end;

  // Объёмная фаска + маркеры краёв (две вертикальные риски — «ручки» ресайза).
  with FBmp.Canvas do
  begin
    Pen.Width := Sc; Brush.Style := bsClear;
    Pen.Color := FTheme.SliderThumbBdr;
    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 + 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 + 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 * Sc then
    begin
      Pen.Color := FTheme.SliderThumbBdr;
      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, 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;

  // Битмап в физических пикселях канвы, иначе Cocoa растянет его и замылит.
  FScale := GetControlScale(FPb);
  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, BmpW, BmpH);
  FBmp.Canvas.Brush.Style := bsSolid;

  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);
var W, L, Wd, Edge: Integer; Lo, Hi, MouseFrac: Double;
begin
  if (FPb = nil) or (Button <> mbLeft) then Exit;
  W := FPb.Width;
  if not ThumbGeom(W, L, Wd) then Exit;
  CurWindow(Lo, Hi);
  FDragLo := Lo; FDragHi := Hi;
  Edge := EdgePx(Wd);
  MouseFrac := X / W;

  if (X >= L) and (X < L + Edge) then
    FDragMode := dmLeft
  else if (X > L + Wd - Edge) and (X <= L + Wd) then
    FDragMode := dmRight
  else if (X >= L) and (X <= L + Wd) then
  begin
    FDragMode := dmBody;
    FDragGrab := MouseFrac - Lo;            // тянем тело за точку захвата
  end
  else
  begin
    // Клик мимо окна → центрируем окно на курсоре, дальше тянем телом.
    FDragMode := dmBody;
    FDragGrab := (Hi - Lo) / 2.0;
    EmitWindow(MouseFrac - FDragGrab, MouseFrac - FDragGrab + (Hi - Lo));
  end;
  if Assigned(FPb) then FPb.Invalidate;
end;

procedure TPanZoomBar.HandleMouseMove(X, Y: Integer);
var W, L, Wd, Edge: Integer; MouseFrac, Width: Double;
begin
  if FPb = nil then Exit;
  W := FPb.Width;
  if W <= 0 then Exit;
  MouseFrac := X / W;

  if FDragMode = dmNone then
  begin
    // Hover: курсор-подсказка над краями (зум) / телом (пан).
    if ThumbGeom(W, L, Wd) then
    begin
      Edge := EdgePx(Wd);
      if ((X >= L) and (X < L + Edge)) or ((X > L + Wd - Edge) and (X <= L + Wd)) then
        FPb.Cursor := crSizeWE
      else if (X >= L) and (X <= L + Wd) then
        FPb.Cursor := crSizeAll
      else
        FPb.Cursor := crDefault;
    end;
    Exit;
  end;

  case FDragMode of
    dmLeft:  EmitWindow(Min(MouseFrac, FDragHi - MIN_VIS), FDragHi);
    dmRight: EmitWindow(FDragLo, Max(MouseFrac, FDragLo + MIN_VIS));
    dmBody:
      begin
        Width := FDragHi - FDragLo;          // ширина фиксирована → зум не меняется
        EmitWindow(EnsureRange(MouseFrac - FDragGrab, 0.0, 1.0 - Width),
                   EnsureRange(MouseFrac - FDragGrab, 0.0, 1.0 - Width) + Width);
      end;
  end;
end;

procedure TPanZoomBar.HandleMouseUp;
begin
  if FDragMode = dmNone then Exit;
  FDragMode := dmNone;
  if Assigned(FPb) then FPb.Invalidate;
end;

procedure TPanZoomBar.HandleDblClick;
begin
  // Сброс к полному диапазону.
  FDragMode := dmNone;
  EmitWindow(0.0, 1.0);
end;

end.