【Delphi】用播放wav格式数据实现的Beep声音

以前播放报警声，我都是使用Windows.Beep(Freq, Duration)来实现，但这个Beep比较死板，播放声音时程序处于等待状态、直到声音播放完毕；另外两个连续的Beep，实际上是有固定的时间间隔的，导致无法快速Beep。下用播放wav格式数据实现的Beep声音，使用起来比较灵活。

unit Unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
 System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
 Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    ButtonBeep: TButton;
    ButtonStartBeep: TButton;
    ButtonStopBeep: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ButtonBeepClick(Sender: TObject);
    procedure ButtonStartBeepClick(Sender: TObject);
    procedure ButtonStopBeepClick(Sender: TObject);
  private
  end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

uses uBeep, System.Generics.Collections;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {$IFDEF DEBUG}
  ReportMemoryLeaksOnShutDown := True;
  {$ENDIF}
end;

procedure TForm1.ButtonBeepClick(Sender: TObject);
begin
  with TBeep.Create(2000{频率}, [50, 100{无声}, 50, 100{无声}, 50]) do
  begin
    Play;
    Free;
  end;
end;

procedure TForm1.ButtonStartBeepClick(Sender: TObject);
begin
  Beep := TBeep.Create(2000{频率}, 100{持续时间});
  Beep.RePlay(1000{重复Beep的时间间隔});
end;

procedure TForm1.ButtonStopBeepClick(Sender: TObject);
begin
  Beep.Stop;
end;

end.

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 168
  ClientWidth = 413
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ButtonStartBeep: TButton
    Left = 232
    Top = 56
    Width = 75
    Height = 25
    Caption = #36830#32493'Beep'
    TabOrder = 1
    OnClick = ButtonStartBeepClick
  end
  object ButtonBeep: TButton
    Left = 104
    Top = 56
    Width = 75
    Height = 25
    Caption = 'Beep'
    TabOrder = 0
    OnClick = ButtonBeepClick
  end
  object ButtonStopBeep: TButton
    Left = 232
    Top = 103
    Width = 75
    Height = 25
    Caption = #20572#27490'Beep'
    TabOrder = 2
    OnClick = ButtonStopBeepClick
  end
end

unit uBeep;

interface

uses Winapi.Windows, System.Classes, System.SysUtils, Vcl.ExtCtrls,
     System.Types, MMSystem;

type
  TBeep = class(TObject)
  private type
    TWavHeader = record         { parameter description }
      Riff_Id  : Cardinal; { 'RIFF'  4 characters }
      Riff_Len : Cardinal; { length of DATA + FORMAT chunk }
      { FORMAT CHUNK }
      Riff_Type: Cardinal; { 'WAVE' }

      Fmt_Id           : Cardinal; { 'fmt ' }
      Fmt_Len          : Cardinal; { length of FORMAT DATA = 16 }
      { format data }
      Fmt_AudioFormat  : Word;     { $01 = PCM }
      Fmt_NumChannels  : Word;     { 1 = mono, 2 = stereo }
      Fmt_SampleRate   : Cardinal; { Sample frequency ie 11025}
      Fmt_ByteRate     : Cardinal; { = nChannels * nSamplesPerSec *
                                    (nBitsPerSample/8) }
      Fmt_BlockAlign   : Word;     { = nChannels * (nBitsPerSAmple / 8 }
      Fmt_BitsPerSample: Word;     { 8 or 16 }

      { DATA CHUNK }
      Data_Id    : Cardinal; { 'data' }
      Data_Length: Cardinal; { length of SAMPLE DATA }
      { sample data : offset 44 }
      { for 8 bit mono = s[0],s[1]... :byte}
      { for 8 bit stereo = sleft[0],sright[0],sleft[1],sright[1]... :byte}
      { for 16 bit mono = s[0],s[1]... :SmallInt}
      { for 16 bit stereo = sleft[0],sright[0],sleft[1],sright[1]... :SmallInt}
     end;
  private
    class var FBeepList: TList;
    class constructor Create;
    class destructor Destroy;
  private
    Timer: TTimer;
    Freq, SampleCount: Cardinal;
    Duration : Double;
    WavHeader: TWavHeader;
    WavData  : array of SmallInt;
    BeepBuff : TBytes;
    procedure InitWavHeader;
    procedure CreateWavData;
    procedure CreateMutedData;
    procedure FilterWavData;
    procedure FillBeepBuff_Data;
    procedure FillBeepBuff_Header;
    procedure TimerTimer(Sender: TObject);
  public
    constructor Create(aFreq: Cardinal = 2500; aDuration: Cardinal = 100{ms}); overload;
    constructor Create(aFreq: Cardinal; aDurations: array of Cardinal); overload;
    destructor  Destroy; override;
    procedure Play;
    procedure Replay(Interval: Cardinal);
    procedure Stop;
  end;

var
  Beep: TBeep;

implementation

constructor TBeep.Create(aFreq, aDuration: Cardinal);
begin
  Create(aFreq, [aDuration]);
end;

constructor TBeep.Create(aFreq: Cardinal; aDurations: array of Cardinal);
var
  I: Integer;
begin
  inherited Create;
  FBeepList.Add(Self);

  Timer := TTimer.Create(nil);

  InitWavHeader;
  SetLength(BeepBuff, Sizeof(WavHeader));

  Freq := aFreq;
  for I := 0 to High(aDurations) do
  begin
    Duration := aDurations[I] / 1000;
    if (I mod 2 = 0) then
      CreateWavData
    else
      CreateMutedData;

    FillBeepBuff_Data;
  end;
  FillBeepBuff_Header;
  WavData := nil;
end;

destructor TBeep.Destroy;
begin
  Timer.Free;
  FBeepList.Remove(Self);
  inherited;
end;

procedure TBeep.InitWavHeader;
begin
  with WavHeader do
  begin
    Riff_Id           := $46464952; { 'RIFF' }
    Riff_Len          := 36;        { length of sample + format }
    Riff_Type         := $45564157; { 'WAVE' }
    Fmt_Id            := $20746d66; { 'fmt ' }
    Fmt_Len           := 16;        { length of format chunk }
    Fmt_AudioFormat   := 1;         { PCM data }
    Fmt_NumChannels   := 1{单声道}; { mono/stereo }
    Fmt_SampleRate    := 2*22050;   { sample rate }
    Fmt_BitsPerSample := 16;        { resolution 8/16 }
    Fmt_ByteRate      := Fmt_NumChannels*Fmt_SampleRate*(Fmt_BitsPerSample div 8);
    Fmt_BlockAlign    := Fmt_NumChannels*(Fmt_BitsPerSample div 8);
  //Fmt_BitsPerSample := 16 { resolution 8/16 } 原有的位置
    Data_Id           := $61746164; { 'data' }
    Data_Length       := 0;         { data length }
  end;
end;

procedure TBeep.CreateWavData;
var
  I: Cardinal;
  A: Double;
begin
  SampleCount := Round(Duration * WavHeader.Fmt_SampleRate) + 1;
  SetLength(WavData, SampleCount);
  A := 2*PI*Freq*Duration/(SampleCount-1);
  for I := 0 to SampleCount-1 do
  begin
    WavData[I] := Round(32760*Sin(I*A));
    FilterWavData;
  end;
end;

procedure TBeep.CreateMutedData;
var
  I: Cardinal;
begin
  SampleCount := Round(Duration * WavHeader.Fmt_SampleRate) + 1;
  SetLength(WavData, SampleCount);
  for I := 0 to SampleCount-1 do
  begin
    WavData[I] := 0;
  end;
end;

procedure TBeep.FilterWavData;
var
  I, N: Cardinal;
  T: Double;
begin
  if Duration >= 0.02 then   //20ms
    T := 0.005 //5ms
  else
    T := Duration / 4;

  //5毫秒对应的取样数
  N := Round(T * WavHeader.Fmt_SampleRate);

  for I := 0 to N do
  begin
    //前N个取样的音量以平方根方式逐步增加
    WavData[I] := Round(SQRT(I/N) * WavData[I]);
  end;

  for I := SampleCount downto SampleCount-N do
  begin
    //后N个取样的音量以平方根方式逐步减少
    WavData[I] := Round(SQRT((SampleCount-I)/N) * WavData[I]);
  end;
end;

procedure TBeep.FillBeepBuff_Data;
var
  L0, L1: Cardinal;
begin
  L0 := Length(BeepBuff);
  L1 := Length(WavData)*WavHeader.Fmt_BlockAlign;
  SetLength(BeepBuff, L0 + L1);
  Move(WavData[0], BeepBuff[L0], L1);
end;

procedure TBeep.FillBeepBuff_Header;
begin
  WavHeader.Data_Length := Length(BeepBuff) - Sizeof(WavHeader);
  WavHeader.Riff_Len    := Length(BeepBuff) - 8;
  Move(WavHeader, BeepBuff[0], Sizeof(WavHeader));
end;

procedure TBeep.Play;
begin
  sndPlaySound(@BeepBuff[0], (SND_ASYNC or SND_MEMORY));
end;

procedure TBeep.Replay(Interval: Cardinal);
begin
  Timer.Interval:= Interval;
  Timer.OnTimer := TimerTimer;
  Timer.Enabled := True;
  TimerTimer(nil);
end;

procedure TBeep.Stop;
begin
  Timer.Enabled := False;
  Timer.OnTimer := nil;
end;

procedure TBeep.TimerTimer(Sender: TObject);
begin
  Play;
end;

class constructor TBeep.Create;
begin
  FBeepList := TList.Create;
end;

class destructor TBeep.Destroy;
var
  Beep: Pointer;
begin
  for Beep in FBeepList do
  begin
    TBeep(Beep).Free;
  end;
  FBeepList.Free;
end;

end.