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; 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; function VisFraction: Double; // доля span, видимая при текущем зуме function ThumbGeom(W: Integer; out L, Wd: Integer): Boolean; // px-геометрия окна 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; 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): 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)); 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; begin 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, Round(H * 0.40)); C.Brush.Style := bsClear; TickMaj := Max(3, Round(H * 0.28)); TickMin := Max(2, 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) then LabelEvery := 1 else if PixPerDiv * 2 >= (C.TextWidth('000.000') + 8) then LabelEvery := 2 else LabelEvery := 4; for i := 0 to NDiv do begin X := Round(i * PixPerDiv); if X >= W then X := W - 1; 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; begin if (Wd <= 0) or (W <= 0) or (H <= 2) 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 := 1; bot := H - 2; 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 := 1; Brush.Style := bsClear; Pen.Color := FTheme.SliderThumbBdr; Rectangle(L, top, L + Wd, bot + 1); 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); 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); // «ручки» захвата по краям (видны, когда окно достаточно широкое) if Wd >= 3 * MIN_THUMB_PX 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); end; Brush.Style := bsSolid; end; end; procedure TPanZoomBar.Paint(Sender: TObject); var W, H, 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); FBmp.Canvas.Brush.Style := bsClear; FBmp.Canvas.Pen.Color := FTheme.RulerBorder; FBmp.Canvas.Rectangle(0, 0, W, H); FBmp.Canvas.Brush.Style := bsSolid; FPb.Canvas.Draw(0, 0, 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.