unit SampleRateOverlay;

{
  Bitmap overlay для выбора sample rate (span) спектра.
  Рисуется прямо в bitmap спектра, как AlertOverlay, поэтому фон под ним
  смешивается вручную через alpha.
}

{$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(TComponent)
  private
    FCurrentRate:    Integer;
    FPanelHidden:    Boolean;
    FOnSpanSelect:   TSpanSelectEvent;
    FOnHidePanel:    THidePanelEvent;
    FOnInvalidate:   TNotifyEvent;
    FLeft:           Integer;
    FTop:            Integer;
    FWidth:          Integer;
    FHeight:         Integer;

    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(Target: TBitmap; C: TCanvas; OriginX, OriginY, W, H: Integer);
    procedure RegisterHit(const HR: TRect; Value: Integer);
    procedure RequestInvalidate;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    procedure DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
    procedure DrawOverlayBitmap(Target: TBitmap; W, H: Integer);
    function HandleMouseMove(X, Y: Integer): Boolean;
    function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
    function HandleMouseLeave: Boolean;
    procedure SetCurrentRate(Rate: Integer);
    procedure SetPanelHidden(Hidden: Boolean);
    property Left: Integer read FLeft;
    property Top: Integer read FTop;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property HotIdx: Integer read FHotIdx;
    property OnSpanSelect: TSpanSelectEvent read FOnSpanSelect write FOnSpanSelect;
    property OnHidePanel:  THidePanelEvent  read FOnHidePanel  write FOnHidePanel;
    property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
  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_TEXT     = TColor($00D8E6EE);
  CLR_BTN_BDR  = TColor($00685624);

procedure BlendRect(Target: TBitmap; const Rct: TRect; R, G, B, Alpha: Byte);
var
  Y, X, InvA: Integer;
  Row: PByte;
  RR: TRect;
begin
  if (Target = nil) or (Alpha = 0) then Exit;
  RR := Rct;
  if RR.Left < 0 then RR.Left := 0;
  if RR.Top < 0 then RR.Top := 0;
  if RR.Right > Target.Width then RR.Right := Target.Width;
  if RR.Bottom > Target.Height then RR.Bottom := Target.Height;
  if (RR.Right <= RR.Left) or (RR.Bottom <= RR.Top) then Exit;

  InvA := 255 - Alpha;
  Target.BeginUpdate(False);
  try
    for Y := RR.Top to RR.Bottom - 1 do
    begin
      Row := PByte(Target.ScanLine[Y]);
      if Row = nil then Continue;
      Inc(Row, RR.Left * 4);
      for X := RR.Left to RR.Right - 1 do
      begin
        Row[0] := Byte((Alpha * B + InvA * Row[0]) div 255);
        Row[1] := Byte((Alpha * G + InvA * Row[1]) div 255);
        Row[2] := Byte((Alpha * R + InvA * Row[2]) div 255);
        Inc(Row, 4);
      end;
    end;
  finally
    Target.EndUpdate(False);
  end;
end;

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);
  FCurrentRate := 192000;
  FPanelHidden := False;
  FHitCount := 0;
  FHotIdx := -1;
  FWidth := 320;
  FHeight := SPAN_H + PAD_Y * 2;
end;

procedure TSampleRateOverlay.RequestInvalidate;
begin
  if Assigned(FOnInvalidate) then FOnInvalidate(Self);
end;

procedure TSampleRateOverlay.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (FLeft = ALeft) and (FTop = ATop) and
     (FWidth = AWidth) and (FHeight = AHeight) then Exit;
  FLeft := ALeft;
  FTop := ATop;
  FWidth := AWidth;
  FHeight := AHeight;
  RequestInvalidate;
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(Target: TBitmap; C: TCanvas;
  OriginX, OriginY, W, H: Integer);
var
  X, I, TW, TH, BtnW, ContentW: Integer;
  HR, FullR: TRect;
  IsAct, IsHot: Boolean;
  Cap: string;
begin
  if (Target = nil) or (C = nil) then Exit;
  FHitCount := 0;

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

  ContentW := PAD_X + HIDE_W + BTN_GAP;
  for I := 0 to High(SPAN_NAMES) do
  begin
    Inc(ContentW, SpanBtnWidth(SPAN_NAMES[I], C));
    if I < High(SPAN_NAMES) then Inc(ContentW, BTN_GAP);
  end;
  Inc(ContentW, PAD_X);
  if ContentW > W then ContentW := W;

  FullR := Rect(OriginX, OriginY, OriginX + ContentW, OriginY + H);
  BlendRect(Target, FullR, $14, $14, $14, 104);
  BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Right, FullR.Top + 1),
    $80, $80, $80, 56);
  BlendRect(Target, Rect(FullR.Left, FullR.Bottom - 1, FullR.Right, FullR.Bottom),
    $00, $00, $00, 48);
  BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Left + 1, FullR.Bottom),
    $80, $80, $80, 42);
  BlendRect(Target, Rect(FullR.Right - 1, FullR.Top, FullR.Right, FullR.Bottom),
    $00, $00, $00, 42);

  X := OriginX + PAD_X;

  HR := Rect(X, OriginY + PAD_Y, X + HIDE_W, OriginY + PAD_Y + SPAN_H);
  IsHot := FHotIdx = 0;
  if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
  else          BlendRect(Target, HR, $18, $3F, $54, 182);
  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.Color := CLR_TEXT;
  C.Brush.Style := bsClear;
  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);

  for I := 0 to High(SPAN_RATES) do
  begin
    BtnW := SpanBtnWidth(SPAN_NAMES[I], C);
    HR := Rect(X, OriginY + PAD_Y, X + BtnW, OriginY + PAD_Y + SPAN_H);
    IsAct := SPAN_RATES[I] = FCurrentRate;
    IsHot := FHotIdx = I + 1;

    if IsAct then       BlendRect(Target, HR, $20, $5A, $78, 220)
    else if IsHot then  BlendRect(Target, HR, $1D, $4B, $62, 206)
    else                BlendRect(Target, HR, $18, $3F, $54, 182);
    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.DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
begin
  if (FWidth <= 0) or (FHeight <= 0) then Exit;
  if (FLeft >= W) or (FTop >= H) then Exit;
  DrawSelf(Target, C, FLeft, FTop, Min(FWidth, W - FLeft), Min(FHeight, H - FTop));
end;

procedure TSampleRateOverlay.DrawOverlayBitmap(Target: TBitmap; W, H: Integer);
var
  HitTarget: TBitmap;
  I, ContentW: Integer;
begin
  if (Target = nil) or (W <= 0) or (H <= 0) then Exit;
  Target.PixelFormat := pf32bit;

  Target.SetSize(8, 8);
  Target.Canvas.Font.Name := 'Courier New';
  Target.Canvas.Font.Size := 7;
  Target.Canvas.Font.Style := [];
  ContentW := PAD_X + HIDE_W + BTN_GAP;
  for I := 0 to High(SPAN_NAMES) do
  begin
    Inc(ContentW, SpanBtnWidth(SPAN_NAMES[I], Target.Canvas));
    if I < High(SPAN_NAMES) then Inc(ContentW, BTN_GAP);
  end;
  Inc(ContentW, PAD_X);
  ContentW := Min(ContentW, W);

  Target.SetSize(ContentW, H);
  Target.Canvas.Brush.Color := TColor($00141414);
  Target.Canvas.Brush.Style := bsSolid;
  Target.Canvas.Pen.Style := psClear;
  Target.Canvas.FillRect(Rect(0, 0, ContentW, H));
  DrawSelf(Target, Target.Canvas, 0, 0, ContentW, H);

  HitTarget := TBitmap.Create;
  try
    HitTarget.PixelFormat := pf32bit;
    HitTarget.SetSize(Max(1, FLeft + ContentW), Max(1, FTop + H));
    HitTarget.Canvas.Brush.Color := TColor($00141414);
    HitTarget.Canvas.FillRect(Rect(0, 0, HitTarget.Width, HitTarget.Height));
    DrawSelf(HitTarget, HitTarget.Canvas, FLeft, FTop, ContentW, H);
  finally
    HitTarget.Free;
  end;
end;

function TSampleRateOverlay.HandleMouseMove(X, Y: Integer): Boolean;
var
  I, OldHot: Integer;
begin
  Result := False;
  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
  begin
    RequestInvalidate;
    Result := True;
  end;
end;

function TSampleRateOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  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;
      Result := True;
      Break;
    end;
end;

function TSampleRateOverlay.HandleMouseLeave: Boolean;
begin
  Result := False;
  if FHotIdx >= 0 then
  begin
    FHotIdx := -1;
    RequestInvalidate;
    Result := True;
  end;
end;

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

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

end.