ewsdr/SampleRateOverlay.pas

unit SampleRateOverlay;

{
  Overlay виджет для выбора sample rate (span) спектра.
  Размещается в верхнем левом углу спектрограммы поверх PbSpectrum.
  Содержит кнопку скрытия левой панели и ряд кнопок span.
}

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

interface

uses
  Classes, SysUtils, Controls, Graphics, Types, Math;

type
  TSpanSelectEvent = procedure(SampleRate: Integer) of object;
  THidePanelEvent  = procedure of object;

  TSampleRateOverlay = class(TCustomControl)
  private
    FCurrentRate:    Integer;
    FPanelHidden:    Boolean;
    FOnSpanSelect:   TSpanSelectEvent;
    FOnHidePanel:    THidePanelEvent;

    FHitRects:   array[0..6] of TRect;   // [0]=hide button, [1..6]=span buttons
    FHitValues:  array[0..6] of Integer; // 0=hide, else sample rate
    FHitCount:   Integer;
    FHotIdx:     Integer;

    procedure DrawSelf(C: TCanvas; W, H: Integer);
    procedure RegisterHit(const HR: TRect; Value: Integer);
  protected
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure MouseLeave; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetCurrentRate(Rate: Integer);
    procedure SetPanelHidden(Hidden: Boolean);
    property OnSpanSelect: TSpanSelectEvent read FOnSpanSelect write FOnSpanSelect;
    property OnHidePanel:  THidePanelEvent  read FOnHidePanel  write FOnHidePanel;
  end;

implementation

const
  SPAN_RATES: array[0..5] of Integer = (48000, 96000, 192000, 384000, 768000, 1536000);
  SPAN_NAMES: array[0..5] of string  = ('48k', '96k', '192k', '384k', '768k', '1536k');

  HIDE_W  = 22;
  SPAN_H  = 18;
  PAD_X   = 4;
  PAD_Y   = 4;
  BTN_GAP = 3;

  CLR_BG       = TColor($00141414);
  CLR_BORDER   = TColor($00505050);
  CLR_TEXT     = TColor($00D8E6EE);
  CLR_BTN_NORM = TColor($00543F18);
  CLR_BTN_HOT  = TColor($00624B1D);
  CLR_BTN_ACT  = TColor($00785A20);
  CLR_BTN_BDR  = TColor($00685624);

function SpanBtnWidth(const Name: string; C: TCanvas): Integer;
begin
  C.Font.Name  := 'Courier New';
  C.Font.Size  := 7;
  C.Font.Style := [];
  Result := C.TextWidth(Name) + 10;
  if Result < 36 then Result := 36;
end;

constructor TSampleRateOverlay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle  := ControlStyle + [csOpaque];
  FCurrentRate  := 192000;
  FPanelHidden  := False;
  FHitCount     := 0;
  FHotIdx       := -1;
  Cursor        := crHandPoint;
  Width         := 320;
  Height        := SPAN_H + PAD_Y * 2;
end;

procedure TSampleRateOverlay.RegisterHit(const HR: TRect; Value: Integer);
begin
  if FHitCount > High(FHitRects) then Exit;
  FHitRects[FHitCount]  := HR;
  FHitValues[FHitCount] := Value;
  Inc(FHitCount);
end;

procedure TSampleRateOverlay.DrawSelf(C: TCanvas; W, H: Integer);
var
  X, I, TW, TH, BtnW: Integer;
  HR: TRect;
  IsAct, IsHot: Boolean;
  Cap: string;
begin
  FHitCount := 0;

  // Фон
  C.Brush.Color := CLR_BG;
  C.Brush.Style := bsSolid;
  C.Pen.Style   := psClear;
  C.FillRect(Rect(0, 0, W, H));

  // Рамка
  C.Pen.Style   := psSolid;
  C.Pen.Color   := CLR_BORDER;
  C.Brush.Style := bsClear;
  C.Rectangle(0, 0, W, H);

  C.Font.Name  := 'Courier New';
  C.Font.Size  := 7;
  C.Font.Style := [];
  TH := C.TextHeight('A');
  X := PAD_X;

  // Кнопка скрытия панели (◀ или ▶)
  HR := Rect(X, PAD_Y, X + HIDE_W, PAD_Y + SPAN_H);
  IsHot := (FHotIdx = 0);
  if IsHot then C.Brush.Color := CLR_BTN_HOT
  else          C.Brush.Color := CLR_BTN_NORM;
  C.Brush.Style := bsSolid; C.Pen.Style := psClear;
  C.FillRect(HR);
  C.Pen.Style := psSolid; C.Pen.Color := CLR_BTN_BDR;
  C.Brush.Style := bsClear; C.Rectangle(HR);
  C.Font.Size   := 8;
  if FPanelHidden then Cap := '▶' else Cap := '◀';
  TW := C.TextWidth(Cap); C.Font.Size := 7;
  C.Font.Color  := CLR_TEXT;
  C.Brush.Style := bsClear;
  C.Font.Size   := 8;
  C.TextOut(HR.Left + (HIDE_W - TW) div 2,
            HR.Top  + (SPAN_H - TH) div 2, Cap);
  C.Font.Size := 7;
  RegisterHit(HR, 0);
  Inc(X, HIDE_W + BTN_GAP);

  // Кнопки span
  for I := 0 to High(SPAN_RATES) do
  begin
    BtnW  := SpanBtnWidth(SPAN_NAMES[I], C);
    HR    := Rect(X, PAD_Y, X + BtnW, PAD_Y + SPAN_H);
    IsAct := (SPAN_RATES[I] = FCurrentRate);
    IsHot := (FHotIdx = I + 1);

    if IsAct then       C.Brush.Color := CLR_BTN_ACT
    else if IsHot then  C.Brush.Color := CLR_BTN_HOT
    else                C.Brush.Color := CLR_BTN_NORM;
    C.Brush.Style := bsSolid; C.Pen.Style := psClear;
    C.FillRect(HR);
    C.Pen.Style := psSolid; C.Pen.Color := CLR_BTN_BDR;
    C.Brush.Style := bsClear; C.Rectangle(HR);

    TW := C.TextWidth(SPAN_NAMES[I]);
    C.Font.Color  := CLR_TEXT;
    C.Brush.Style := bsClear;
    C.TextOut(HR.Left + (BtnW - TW) div 2,
              HR.Top  + (SPAN_H - TH) div 2, SPAN_NAMES[I]);

    RegisterHit(HR, SPAN_RATES[I]);
    Inc(X, BtnW + BTN_GAP);
  end;
end;

procedure TSampleRateOverlay.Paint;
begin
  DrawSelf(Canvas, Width, Height);
end;

procedure TSampleRateOverlay.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  I, OldHot: Integer;
begin
  OldHot := FHotIdx;
  FHotIdx := -1;
  for I := 0 to FHitCount - 1 do
    if PtInRect(FHitRects[I], Point(X, Y)) then
    begin
      FHotIdx := I;
      Break;
    end;
  if FHotIdx <> OldHot then Invalidate;
  inherited MouseMove(Shift, X, Y);
end;

procedure TSampleRateOverlay.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  if Button <> mbLeft then Exit;
  for I := 0 to FHitCount - 1 do
    if PtInRect(FHitRects[I], Point(X, Y)) then
    begin
      if FHitValues[I] = 0 then
      begin
        if Assigned(FOnHidePanel) then FOnHidePanel;
      end
      else
      begin
        if Assigned(FOnSpanSelect) then FOnSpanSelect(FHitValues[I]);
      end;
      Break;
    end;
end;

procedure TSampleRateOverlay.MouseLeave;
begin
  if FHotIdx >= 0 then
  begin
    FHotIdx := -1;
    Invalidate;
  end;
  inherited MouseLeave;
end;

procedure TSampleRateOverlay.SetCurrentRate(Rate: Integer);
begin
  if FCurrentRate = Rate then Exit;
  FCurrentRate := Rate;
  Invalidate;
end;

procedure TSampleRateOverlay.SetPanelHidden(Hidden: Boolean);
begin
  if FPanelHidden = Hidden then Exit;
  FPanelHidden := Hidden;
  Invalidate;
end;

end.