SndPlayer.pas

File name
C:\Users\Andreas Rejbrand\Documents\Dev\AlgoSim\Client\Controls\SndPlayer.pas
Date exported
Time exported
Formatting processor
TPascalFormattingProcessor
unit SndPlayer;

interface

uses
  Windows, Messages, Menus, SysUtils, Types, Classes, Graphics, Forms, Controls,
  UITypes, ASSounds, Generics.Defaults, Generics.Collections, ExtCtrls, Dialogs;

type
  TSoundState = (sndStopped, sndPlaying, sndPaused);
  TSoundPlayer = class(TCustomControl)
  strict private
  type
    TButtonState = (bsNormal, bsHot, bsFocused, bsDown);
  const
    FaceColors: array[TButtonState] of TColor =
      ($00E0E0E0, $00D0D0D0, $00E0E0E0, $00000000);
    TextColors: array[TButtonState] of TColor =
      ($00000000, $00000000, $00000000, $00FFFFFF);
  type
    TButton = (btnPlayPause, btnStop);
    TButtonHelper = record helper for TButton
      function Index: Integer; inline;
      function Next: TButton; inline;
      function Prev: TButton; inline;
    end;
    TButtonIndex = -1..Ord(High(TButton));
  const
    ButtonCount = Ord(High(TButton)) - Ord(Low(TButton)) + 1;
  type
    TCtlState = array[TButton] of TButtonState;
    TSndIcon = (iPlay, iPause, iStop);
  const
    WM_STARTPLAY = WM_APP + 1;
    STARTPLAY_FACTOR = 100;
  var
    FCtlState: TCtlState;
    FSound: TASSound;
    FButtonWidth: Integer;
    FPadding: Integer;
    FDownButton: TButton;
    FFocusButton: TButton;
    FSndState: TSoundState;
    //
    //             ---------------        -----------------
    //             |   ACTIVE    |        |    STOPPED    |
    //             ---------------        -----------------
    //                    |
    //             ----------------
    //             |              |
    //        -----------    -----------
    //        | PLAYING |    | PAUSED  |
    //        -----------    -----------
    //
    FTrackbarUpdater: TTimer;
    FPosition, FTargetPosition: Double;
    FAutoRestart: Boolean;
    FMovingTrackbar: Boolean;
    FContextMenu: TPopupMenu;
    FmiSndInfo: TMenuItem;
    FmiSndSave: TMenuItem;
  class var
    FSoundPlayers: TList<TSoundPlayer>;
    procedure PostPlayMessage(const APosition: Double);
    procedure DoPlay(const APosition: Double);
    procedure SetSound(ASound: TASSound);
    procedure ComputeMetrics;
    function ButtonRect(Button: TButton): TRect;
    function FocusRect(Button: TButton): TRect;
    function TrackbarRect: TRect;
    function TrackbarSuperRect: TRect;
    function LabelRect: TRect;
    function ThumbRect: TRect;
    function ButtonFaceColor(State: TButtonState): TColor;
    function ButtonTextColor(State: TButtonState): TColor;
    function HitTest(const P: TPoint): TButtonIndex;
    function ContrastColor: TColor;
    function TrackbarPosition(const ATime: Double): Integer;
    function TimePosition(ATrackbarPosition: Integer): Double;
    procedure ButtonClicked(Button: TButton);
    procedure DrawButton(Button: TButton);
    procedure DrawButtons;
    procedure DrawTrackbar;
    procedure DrawLabels;
    function FormatDuration(const ADuration: Double; AVerbose: Boolean = False): string;
    procedure SetState(const ANewState: TCtlState);
    function KbdState: TCtlState;
    function EmptyState: TCtlState; inline;
    procedure TrackbarUpdaterTimer(Sender: TObject);
    procedure UpdateTrackbar;
    procedure SetPosition(const APosition: Double);
    procedure EnableTrackbarUpdater;
    procedure DisableTrackbarUpdater;
    procedure SndInfoClick(Sender: TObject);
    procedure SndSaveClick(Sender: TObject);
    procedure ContextMenuPopup(Sender: TObject);
    class procedure DrawIcon(AIcon: TSndIcon; ACanvas: TCanvas;
      const ARect: TRect; AColor: TColor); static;
    class procedure SndSysPlaybackEvent(APlayerID: NativeInt;
      AEventType: TSoundPlaybackEventType);
    class constructor ClassCreate;
    class destructor ClassDestroy;
    procedure WMStartPlay(var Message: TMessage); message WM_STARTPLAY;
  private
    procedure PlaybackEvent(APlayerID: NativeInt;
      AEventType: TSoundPlaybackEventType);
  protected
    procedure Paint; override;
    procedure Loaded; override;
    procedure Resize; override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMContextMenu(var Message: TWMContextMenu);
      message WM_CONTEXTMENU;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property State: TSoundState read FSndState;
    procedure PlayFrom(const APosition: Double = 0.0);
    procedure Play;
    procedure PlayPause;
    procedure Pause;
    procedure Stop;
    property Position: Double read FPosition write SetPosition;
    class function PreferredHeight: Integer; static;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Color;
    property Ctl3D;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Padding;
    property ParentBackground;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Sound: TASSound read FSound write SetSound;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Touch;
    property Visible;
    property StyleElements;
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDockDrop;
    property OnDockOver;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

uses
  Math, TableDialog;

function _scale(X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;

{ TSoundPlayer }

procedure TSoundPlayer.ButtonClicked(Button: TButton);
begin
  if FSound.Data = nil then
    Exit;
  case Button of
    btnPlayPause:
      PlayPause;
    btnStop:
      Stop;
  end;
end;

function TSoundPlayer.ButtonFaceColor(State: TButtonState): TColor;
begin
  Result := FaceColors[State];
end;

function TSoundPlayer.ButtonRect(Button: TButton): TRect;
begin
  Result.TopLeft := Point(Button.Index * FButtonWidth, 0);
  Result.Size := TSize.Create(FButtonWidth, FButtonWidth);
end;

function TSoundPlayer.ButtonTextColor(State: TButtonState): TColor;
begin
  Result := TextColors[State];
end;

class constructor TSoundPlayer.ClassCreate;
begin
  FSoundPlayers := TList<TSoundPlayer>.Create;
  TASSound.OnPlaybackEvent := SndSysPlaybackEvent;
end;

class destructor TSoundPlayer.ClassDestroy;
begin
  FreeAndNil(FSoundPlayers);
end;

procedure TSoundPlayer.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TSoundPlayer.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  SetState(KbdState);
end;

procedure TSoundPlayer.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  Constraints.MinHeight := PreferredHeight;
  Constraints.MaxHeight := PreferredHeight;
  Constraints.MinWidth := ButtonCount * FButtonWidth + _Scale(8) + 3*FButtonWidth;
end;

procedure TSoundPlayer.ComputeMetrics;
begin
  FButtonWidth := _scale(32);
  FPadding := Max(FButtonWidth div 10, 2);
  Height := FButtonWidth;
end;

function IsDark(Color: TColor): Boolean;
var
  c: TColor;
begin
  c := ColorToRGB(Color);
  Result := GetRValue(c) + GetGValue(c) + GetBValue(c) < 3 * 127;
end;

procedure TSoundPlayer.ContextMenuPopup(Sender: TObject);
begin
  FmiSndInfo.Enabled := FSound.Data <> nil;
  FmiSndSave.Enabled := FSound.Data <> nil;
end;

function TSoundPlayer.ContrastColor: TColor;
const
  ContrastColors: array[Boolean] of TColor = (clBlack, clWhite);
begin
  Result := ContrastColors[IsDark(Color)];
end;

constructor TSoundPlayer.Create(AOwner: TComponent);
begin

  inherited;

  TabStop := True;

  if Assigned(FSoundPlayers) then
    FSoundPlayers.Add(Self);

  FTrackbarUpdater := TTimer.Create(Self);
  FTrackbarUpdater.Interval := 100;
  FTrackbarUpdater.Enabled := False;
  FTrackbarUpdater.OnTimer := TrackbarUpdaterTimer;

  FContextMenu := TPopupMenu.Create(Self);
  FContextMenu.OnPopup := ContextMenuPopup;

  FmiSndInfo := TMenuItem.Create(FContextMenu);
  FmiSndInfo.Caption := 'Audio metadata';
  FmiSndInfo.Hint := 'Displays the properties of the current waveform audio data.';
  FmiSndInfo.OnClick := SndInfoClick;
  FContextMenu.Items.Add(FmiSndInfo);

  FmiSndSave := TMenuItem.Create(FContextMenu);
  FmiSndSave.Caption := 'Save as...';
  FmiSndSave.Hint := 'Saves the audio as a PCM WAV file.';
  FmiSndSave.OnClick := SndSaveClick;
  FContextMenu.Items.Add(FmiSndSave);

  ComputeMetrics;

  Constraints.MinHeight := PreferredHeight;
  Constraints.MaxHeight := PreferredHeight;
  Constraints.MinWidth := ButtonCount * FButtonWidth + _Scale(8) + 3*FButtonWidth;

  FCurrentPPI := Screen.PixelsPerInch;

end;

destructor TSoundPlayer.Destroy;
begin
  if Assigned(FSoundPlayers) then
    FSoundPlayers.Remove(Self);
  inherited;
end;

procedure TSoundPlayer.DisableTrackbarUpdater;
begin
  FTrackbarUpdater.Enabled := False;
  UpdateTrackbar;
end;

procedure TSoundPlayer.DoPlay(const APosition: Double);
begin
  Screen.Cursor := crHourGlass;
  try
    FSound.Play(APosition);
  finally
    Screen.Cursor := crDefault;
  end;
end;

function AvgColor(A, B: TColor): TColor;
begin
  A := ColorToRGB(A);
  B := ColorToRGB(B);
  Result := RGB(
    (GetRValue(A) + GetRValue(B)) div 2,
    (GetGValue(A) + GetGValue(B)) div 2,
    (GetBValue(A) + GetBValue(B)) div 2
  );
end;

procedure TSoundPlayer.DrawButton(Button: TButton);
begin
  if not InRange(Button.Index, 0, ButtonCount - 1) then
    Exit;
  Canvas.Brush.Color := ButtonFaceColor(FCtlState[Button]);
  Canvas.Font.Color := ButtonTextColor(FCtlState[Button]);
  if (FSound.Data = nil) or not Enabled then
    Canvas.Font.Color := AvgColor(Canvas.Font.Color, Canvas.Brush.Color);
  Canvas.FillRect(ButtonRect(Button));
  if (FCtlState[Button] = bsFocused) and (FSound.Data <> nil) then
    Canvas.DrawFocusRect(FocusRect(Button));
  case Button of
    btnPlayPause:
      if State = sndPlaying then
        DrawIcon(iPause, Canvas, ButtonRect(Button), Canvas.Font.Color)
      else
        DrawIcon(iPlay, Canvas, ButtonRect(Button), Canvas.Font.Color);
    btnStop:
      DrawIcon(iStop, Canvas, ButtonRect(Button), Canvas.Font.Color)
  end;
end;

procedure TSoundPlayer.DrawButtons;
var
  Btn: TButton;
begin
  for Btn := Low(TButton) to High(TButton) do
    DrawButton(Btn);
end;

class procedure TSoundPlayer.DrawIcon(AIcon: TSndIcon; ACanvas: TCanvas;
  const ARect: TRect; AColor: TColor);
var
  R: TRect;
begin
  case AIcon of
    iPlay:
      begin
        R := ARect;
        R.Inflate(-ARect.Height div 4, -ARect.Height div 4);
        ACanvas.Brush.Color := AColor;
        ACanvas.Polygon(
          [
            R.TopLeft,
            Point(R.Right, R.CenterPoint.Y),
            Point(R.Left, R.Bottom)
          ]
        );
      end;
    iPause:
      begin
        R := ARect;
        R.Inflate(-ARect.Height div 4, -ARect.Height div 4);
        R.Width := Max(1, 3 * ARect.Height div 16);
        ACanvas.Brush.Color := AColor;
        ACanvas.FillRect(R);
        R.Offset(Round(5 * ARect.Height / 16), 0);
        ACanvas.FillRect(R);
      end;
    iStop:
      begin
        R := ARect;
        R.Inflate(-ARect.Height div 4, -ARect.Height div 4);
        ACanvas.Brush.Color := AColor;
        ACanvas.FillRect(R);
      end;
  end;
end;

procedure TSoundPlayer.DrawLabels;
var
  R: TRect;
  S: string;
begin
  S := FormatDuration(FPosition) + ' / ' + FormatDuration(FSound.Duration);
  R := LabelRect;
  Canvas.Brush.Color := Color;
  Canvas.Font.Assign(Font);
  if (FSound.Data = nil) or not Enabled then
    Canvas.Font.Color := AvgColor(ContrastColor, Color)
  else
    Canvas.Font.Color := ContrastColor;
  if Canvas.TextWidth(S) > R.Width then
  begin
    S := FormatDuration(FPosition) + '/' + FormatDuration(FSound.Duration);
    if Canvas.TextWidth(S) > R.Width then
      S := FormatDuration(FPosition);
  end;
  Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfLeft])
end;

procedure TSoundPlayer.DrawTrackbar;
begin
  if TrackbarRect.Width <= 2*ThumbRect.Width then
    Exit;
  if (FSound.Data = nil) or not Enabled then
    Canvas.Brush.Color := AvgColor(ContrastColor, Color)
  else
    Canvas.Brush.Color := ContrastColor;
  Canvas.FillRect(TrackbarRect);
  Canvas.FillRect(ThumbRect);
end;

function TSoundPlayer.EmptyState: TCtlState;
begin
  FillChar(Result, sizeof(Result), 0);
end;

procedure TSoundPlayer.EnableTrackbarUpdater;
begin
  FTrackbarUpdater.Enabled := True;
  UpdateTrackbar;
end;

function TSoundPlayer.FocusRect(Button: TButton): TRect;
begin
  Result := ButtonRect(Button);
  Result.Inflate(-FPadding, -FPadding);
end;

function TSoundPlayer.FormatDuration(const ADuration: Double;
  AVerbose: Boolean): string;
var
  h, m, s, ds: Integer;
begin
  ds := Trunc(10*Frac(ADuration));
  s := Trunc(ADuration);
  m := s div 60;
  h := s div 3600;
  Dec(s, 60 * m);
  Dec(m, 60 * h);
  if AVerbose then
  begin
    if (h = 0) and (m = 0) then
      Result := Format('%d.%d sec', [s, ds])
    else if h = 0 then
      Result := Format('%d min %.2d sec', [m, s])
    else
      Result := Format('%d h %.2d min %.2d sec', [h, m, s]);
  end
  else
  begin
    if (h = 0) and (m = 0) then
      Result := Format('%d.%d', [s, ds])
    else if h = 0 then
      Result := Format('%d:%.2d', [m, s])
    else
      Result := Format('%d:%.2d:%.2d', [h, m, s]);
  end;
end;

function TSoundPlayer.HitTest(const P: TPoint): TButtonIndex;
var
  Btn: TButton;
begin
  for Btn := Low(TButton) to High(TButton) do
    if ButtonRect(Btn).Contains(P) then
      Exit(Btn.Index);
  Result := -1;
end;

function TSoundPlayer.KbdState: TCtlState;
begin
  FillChar(Result, sizeof(Result), 0);
  if Focused then
    Result[FFocusButton] := bsFocused;
end;

procedure TSoundPlayer.KeyDown(var Key: Word; Shift: TShiftState);
var
  NewState: TCtlState;
begin
  inherited;
  if FSound.Data = nil then
    Exit;
  case Key of
    VK_RIGHT:
      begin
        FFocusButton := FFocusButton.Next;
        SetState(KbdState);
      end;
    VK_LEFT:
      begin
        FFocusButton := FFocusButton.Prev;
        SetState(KbdState);
      end;
    VK_SPACE:
      begin
        NewState := KbdState;
        NewState[FFocusButton] := bsDown;
        SetState(NewState);
      end;
    VK_HOME:
      Position := 0;
    VK_END:
      Position := FSound.Duration;
    VK_NEXT:
      Position := FPosition + 1;
    VK_PRIOR:
      Position := FPosition - 1;
  end;
end;

procedure TSoundPlayer.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if FSound.Data = nil then
    Exit;
  case Key of
    VK_SPACE:
      begin
        SetState(KbdState);
        ButtonClicked(FFocusButton);
      end;
  end;
end;

procedure TSoundPlayer.Loaded;
begin
  inherited;
  ComputeMetrics;
  Invalidate;
end;

procedure TSoundPlayer.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  NewState: TCtlState;
  Btn: TButton;
  R: TRect;
begin
  inherited;
  FMovingTrackbar := False;
  if FSound.Data = nil then
    Exit;
  if CanFocus then
    SetFocus;
  NewState := EmptyState;
  for Btn := Low(TButton) to High(TButton) do
    if ButtonRect(Btn).Contains(Point(X, Y)) then
    begin
      if Button = mbLeft then
      begin
        NewState[Btn] := bsDown;
        FDownButton := Btn;
      end;
      FFocusButton := Btn;
      Break;
    end;
  if (NewState[FFocusButton] = bsNormal) and Focused then
    NewState[FFocusButton] := bsFocused;
  SetState(NewState);
  if (Button = mbLeft) and TrackbarSuperRect.Contains(Point(X, Y)) then
  begin
    SetPosition(TimePosition(X));
    R := TrackbarRect;
    R := TRect.Create(ClientToScreen(R.TopLeft), R.Width, R.Height);
    ClipCursor(@R);
    FMovingTrackbar := True;
  end;
end;

procedure TSoundPlayer.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TCtlState;
  Btn: TButton;
begin

  inherited;

  if FSound.Data = nil then
    Exit;

  if (csLButtonDown in ControlState) and FMovingTrackbar then
  begin
    SetPosition(TimePosition(X));
    Exit;
  end;

  NewState := KbdState;
  for Btn := Low(TButton) to High(TButton) do
    if ButtonRect(Btn).Contains(Point(X, Y)) then
      if (Btn = FDownButton) and (csLButtonDown in ControlState) then
        NewState[Btn] := bsDown
      else
        NewState[Btn] := bsHot;
  SetState(NewState);

end;

procedure TSoundPlayer.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if FSound.Data = nil then
    Exit;
  MouseMove(Shift, X, Y);
  if Button = mbLeft then
    if (FDownButton.Index <> -1) and (FDownButton.Index = HitTest(Point(X, Y))) then
      ButtonClicked(FDownButton);
  ClipCursor(nil);
  FMovingTrackbar := False;
  if FAutoRestart then
  begin
    FAutoRestart := False;
    if FSndState = sndStopped then
      PlayFrom(FTargetPosition);
  end
end;

procedure TSoundPlayer.Paint;
begin
  inherited;
  DrawButtons;
  DrawTrackbar;
  DrawLabels;
end;

procedure TSoundPlayer.Pause;
begin
  if FSound.Data = nil then
    Exit;
  case FSndState of
    sndStopped: ;
    sndPlaying:
      FSound.Pause;
    sndPaused: ;
  end;
end;

procedure TSoundPlayer.Play;
begin
  if FSound.Data = nil then
    Exit;
  case FSndState of
    sndStopped:
      PlayFrom(FPosition);
    sndPlaying: ;
    sndPaused:
      FSound.Restart;
  end;
end;

procedure TSoundPlayer.PlaybackEvent(APlayerID: NativeInt;
  AEventType: TSoundPlaybackEventType);
begin
  if APlayerID <> NativeInt(Self) then
    Exit;
  case AEventType of
    pevStart, pevResume:
      begin
        FSndState := sndPlaying;
        EnableTrackbarUpdater;
      end;
    pevPause:
      begin
        FSndState := sndPaused;
        DisableTrackbarUpdater;
      end;
    pevStop, pevEnd:
      begin
        FSndState := sndStopped;
        DisableTrackbarUpdater;
        if FAutoRestart and not (csLButtonDown in ControlState) then
        begin
          FAutoRestart := False;
          PlayFrom(FTargetPosition);
        end;
      end;
  end;
  DrawButtons;
end;

procedure TSoundPlayer.PlayFrom(const APosition: Double);
begin
  if FSound.Data = nil then
    Exit;
  if FSndState <> sndStopped then
    Exit;
  if TASSound.Playing then
    TASSound.Stop;
  PostPlayMessage(APosition);
end;

procedure TSoundPlayer.PlayPause;
begin
  if FSound.Data = nil then
    Exit;
  case FSndState of
    sndStopped:
      PlayFrom(FTargetPosition);
    sndPlaying:
      FSound.Pause;
    sndPaused:
      FSound.Restart;
  end;
end;

procedure TSoundPlayer.PostPlayMessage(const APosition: Double);
begin
  PostMessage(Handle, WM_STARTPLAY, NativeUInt(Round(STARTPLAY_FACTOR * APosition)), 0);
end;

class function TSoundPlayer.PreferredHeight: Integer;
begin
  Result := _Scale(32);
end;

procedure TSoundPlayer.Resize;
begin
  inherited;
  ComputeMetrics;
  Invalidate;
end;

procedure TSoundPlayer.SetPosition(const APosition: Double);
begin
  FTargetPosition := EnsureRange(APosition, 0, FSound.Duration);
  if FSndState <> sndStopped then
  begin
    FAutoRestart := FSndState = sndPlaying;
    TASSound.Stop;
    TASSound.WaitFor(5000)
  end;
  UpdateTrackbar;
end;

procedure TSoundPlayer.SetSound(ASound: TASSound);
begin
  if FSndState <> sndStopped then
    raise Exception.Create('Cannot change audio source while the audio is still playing.');
  if csLButtonDown in ControlState then
    ClipCursor(nil);
  FSound := ASound.Clone;
  FSound.PlayerID := NativeInt(Self);
  FPosition := 0.0;
  FTargetPosition := 0.0;
  FAutoRestart := False;
  Invalidate;
end;

procedure TSoundPlayer.SetState(const ANewState: TCtlState);
var
  Btn: TButton;
begin
  for Btn := Low(TButton) to High(TButton) do
    if FCtlState[Btn] <> ANewState[Btn] then
      InvalidateRect(Handle, ButtonRect(Btn), False);
  FCtlState := ANewState;
end;

var
  PrettyIntFS: TFormatSettings;

function IntToPrettyStr(AValue: Integer): string;
begin
  Result := Format('%.0n', [Double(AValue)], PrettyIntFS);
end;

procedure TSoundPlayer.SndInfoClick(Sender: TObject);
var
  frm: TCustomForm;
  LMaxFrac: Double;
const
  nl = SLineBreak;
begin

  if FSound.Data = nil then
    Exit;

  frm := GetParentForm(Self);
  if frm = nil then
    frm := Screen.ActiveForm;
  if frm = nil then
    frm := Application.MainForm;

  Screen.Cursor := crHourGlass;
  try
    try
      LMaxFrac := FSound.MaxFraction;
    except
      on ESoundException do
        LMaxFrac := -1.0;
    end;
  finally
    Screen.Cursor := crDefault;
  end;

  TTableDialog.ShowTable(
    frm,
    'Audio Metadata',
    ['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate', 'Highest sample'],
    [
      Format('%s', [FormatDuration(FSound.Duration, True)]),
      Format('%s', [IntToPrettyStr(FSound.SampleLength)]),
      Format('%s B', [IntToPrettyStr(FSound.DataLength)]),
      Format('%d', [FSound.ChannelCount]),
      Format('%d', [FSound.BitsPerSample]),
      Format('%s Hz', [IntToPrettyStr(FSound.SampleFrequency)]),
      Format('%s bits/sec',
        [IntToPrettyStr(FSound.BitsPerSample * FSound.SampleFrequency * FSound.ChannelCount)]),
      Format('%.4f', [LMaxFrac], TFormatSettings.Invariant)
    ],
    mtCustom
  );

end;

procedure TSoundPlayer.SndSaveClick(Sender: TObject);
var
  Dlg: TFileSaveDialog;
begin

  if FSound.Data = nil then
    Exit;

  Dlg := TFileSaveDialog.Create(Self);
  try
    Dlg.DefaultExtension := 'wav';
    Dlg.Options := [fdoOverWritePrompt, fdoPathMustExist];
    Dlg.Title := 'Save Audio';
    with Dlg.FileTypes.Add do
    begin
      DisplayName := 'PCM Waveform Audio';
      FileMask := '*.wav';
    end;
    if Dlg.Execute then
      FSound.SaveToFile(Dlg.FileName);
  finally
    Dlg.Free;
  end;

end;

class procedure TSoundPlayer.SndSysPlaybackEvent(
  APlayerID: NativeInt; AEventType: TSoundPlaybackEventType);
var
  SoundPlayer: TSoundPlayer;
begin
  if Assigned(FSoundPlayers) then
    for SoundPlayer in FSoundPlayers do
      SoundPlayer.PlaybackEvent(APlayerID, AEventType);
end;

procedure TSoundPlayer.Stop;
begin
  if FSound.Data = nil then
    Exit;
  if FSndState = sndStopped then
    SetPosition(0)
  else
    FSound.Stop;
end;

function TSoundPlayer.LabelRect: TRect;
begin
  Result := Rect(ClientWidth - 3*FButtonWidth, 0, ClientWidth, ClientHeight);
end;

function TSoundPlayer.ThumbRect: TRect;
var
  H, W: Integer;
begin
  H := _scale(10);
  W := _scale(6);
  Result.Top := TrackbarRect.CenterPoint.Y - H div 2;
  Result.Left := TrackbarPosition(FPosition) - W div 2;
  Result.Height := H;
  Result.Width := W;
end;

function TSoundPlayer.TimePosition(ATrackbarPosition: Integer): Double;
begin
  if (FSound.Data = nil) or (TrackbarRect.Width = 0) then
    Result := 0.0
  else
    Result := FSound.Duration * ((ATrackbarPosition - TrackbarRect.Left) / TrackbarRect.Width);
  Result := EnsureRange(Result, 0, FSound.Duration);
end;

function TSoundPlayer.TrackbarPosition(const ATime: Double): Integer;
begin
  if IsZero(FSound.Duration) then
    Result := 0
  else
    Result := TrackbarRect.Left + Round((ATime / FSound.Duration) * TrackbarRect.Width);
  Result := EnsureRange(Result, TrackbarRect.Left, TrackbarRect.Right);
end;

function TSoundPlayer.TrackbarRect: TRect;
var
  TrackbarHeight: Integer;
begin
  TrackbarHeight := _scale(3);
  Result.Left := FButtonWidth * ButtonCount + FButtonWidth div 2;
  Result.Top := (ClientHeight - TrackbarHeight) div 2;
  Result.Right := ClientWidth - 3 * FButtonWidth - FButtonWidth div 2;
  Result.Height := TrackbarHeight;
end;

function TSoundPlayer.TrackbarSuperRect: TRect;
begin
  Result := TrackbarRect;
  Result.Inflate(Result.Height * 2, Result.Height * 4);
end;

procedure TSoundPlayer.TrackbarUpdaterTimer(Sender: TObject);
begin
  UpdateTrackbar;
end;

procedure TSoundPlayer.UpdateTrackbar;
begin
  if FSndState <> sndStopped then
    FPosition := FSound.Position
  else
    FPosition := FTargetPosition;
  InvalidateRect(Handle, TrackbarSuperRect, True);
  InvalidateRect(Handle, LabelRect, True);
end;

procedure TSoundPlayer.WMContextMenu(var Message: TWMContextMenu);
begin

  if (Message.XPos = -1) and (Message.YPos = -1) then // menu key or Shift+F10
    with ClientToScreen(Point(0, ClientHeight)) do
      FContextMenu.Popup(x, y)
  else // RMB
    FContextMenu.Popup(Message.XPos, Message.YPos);

  Message.Result := 1;

end;

procedure TSoundPlayer.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := Message.Result or DLGC_WANTARROWS;
end;

procedure TSoundPlayer.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  SetState(KbdState);
end;

procedure TSoundPlayer.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  SetState(KbdState);
end;

procedure TSoundPlayer.WMStartPlay(var Message: TMessage);
begin
  DoPlay(Message.WParam / STARTPLAY_FACTOR);
end;

{ TSoundPlayer.TButtonHelper }

function TSoundPlayer.TButtonHelper.Index: Integer;
begin
  Result := Ord(Self);
end;

function TSoundPlayer.TButtonHelper.Next: TButton;
begin
  Result := TButton(Succ(Index) mod ButtonCount);
end;

function TSoundPlayer.TButtonHelper.Prev: TButton;
begin
  Result := TButton((ButtonCount + Pred(Index)) mod ButtonCount);
end;

procedure Register;
begin
  RegisterComponents('Rejbrand 2020', [TSoundPlayer]);
end;

initialization
  PrettyIntFS := TFormatSettings.Invariant;
  PrettyIntFS.ThousandSeparator := #32;

end.