Language : English Indonesia

Generating tone with Delphi

Zamrony P Juhara

15 September 2006 16:56:00

(5286 views)

Tutorial about how to create tone generator with Delphi

Introduction

To produce tone with frequency defined at runtime, we can use Windows's Beep() function. This function is simple but unfortunately may not suit for some cases. For example, beep generated sound cannot be stored in a file.

This problem have arouse at Delphindo mailing list. Therefore, I decide to write article about it. For this article, I am going to develop tone generator application. I created this tone generator when I was involved in a active noise cancellation project, i.e, active noise reduction system where sound wave is damped by using same sound wave but out of phase 180 degree. ok let's go to code.

Tone Generator Implementation

Following code are declarations of types we use in tone generator and some helper functions. It is not too hard, is it?

{======================================
Sound type definition
=======================================
(c) 2006 zamrony p juhara
=======================================}
unit uSoundTypes;

interface

type

  TVolumeLevel = 0..127;
  TSampleRate=(sr8KHz,sr11_025KHz,sr22_05KHz,sr44_1KHz);
  TSoundChannel=(chMono,chStereo);
  TBitsPerSample=(bps8Bit,bps16Bit,bps32Bit);

function GetSampleRate(SampleRate:TSampleRate):integer;
function GetEnumSampleRate(SampleRate:integer):TSampleRate;

function GetNumChannels(ch:TSoundChannel):word;
function GetSoundChannels(nChannel:word):TSoundChannel;

function GetBitsPerSample(bits:TBitsPerSample):word;
function GetEnumBitsPerSample(bits:word):TBitsPerSample;

implementation


const SampleRates:array[sr8KHz..sr44_1KHz] of integer=
       (8000,11025,22050,44100);

     Channels:array[chMono..chStereo] of word=
     (1,2);
     BitsPerSample:array[bps8Bit..bps32Bit] of word=
     (8,16,32);

function GetSampleRate(SampleRate:TSampleRate):integer;
begin
  result:=SampleRates[SampleRate];
end;

function GetEnumSampleRate(SampleRate:integer):TSampleRate;
begin
  result:=sr8KHz;
  case sampleRate of
    8000:result:=sr8KHz;
    11025:result:=sr11_025KHz;
    22050:result:=sr22_05KHz;
    44100:result:=sr44_1KHz;
  end;
end;

function GetNumChannels(ch:TSoundChannel):word;
begin
  result:=Channels[ch];
end;

function GetSoundChannels(nChannel:word):TSoundChannel;
begin
  result:=chMono;
  case nChannel of
    1:result:=chMono;
    2:result:=chStereo;
  end;
end;

function GetBitsPerSample(bits:TBitsPerSample):word;
begin
  result:=BitsPerSample[bits];
end;

function GetEnumBitsPerSample(bits:word):TBitsPerSample;
begin
  result:=bps8Bit;
  case bits of
    8:result:=bps8Bit;
    16:result:=bps16Bit;
    32:result:=bps32Bit;
  end;
end;

end.

Next is core of tone generator application.

{======================================
Tone Generator Wrapper class
=======================================
(c) 2006 zamrony p juhara
=======================================}

unit uToneGenerator;

interface
uses classes,uSoundTypes;


type
  TBasicToneGenerator=class(TPersistent)
  private
    FStream:TMemoryStream;
    FDuration: integer;
    FSampleRate: TSampleRate;
    FVolume: TVolumeLevel;
    FChannel: TSoundChannel;
    procedure SetDuration(const Value: integer);
    procedure SetSampleRate(const Value: TSampleRate);
    procedure SetVolume(const Value: TVolumeLevel);
    procedure SetChannel(const Value: TSoundChannel);
  protected

  public
    constructor Create;virtual;
    destructor Destroy;override;
    procedure Generate;virtual;
    procedure Play;
    procedure PlaySync;
    procedure SaveToStream(Stream:TStream);
    procedure SaveToFile(const filename:string);
    procedure LoadFromStream(Stream:TStream);
    procedure LoadFromFile(const filename:string);
  published
    property SampleRate:TSampleRate read FSampleRate write SetSampleRate;
    property Duration:integer read FDuration write SetDuration;
    property Volume:TVolumeLevel read FVolume write SetVolume;
    property Channel:TSoundChannel read FChannel write SetChannel;
    property ToneStream:TMemoryStream read FStream;
  end;

  TToneGenerator=class(TBasicToneGenerator)
  private
    FFrequency: integer;
    procedure SetFrequency(const Value: integer);
  public
    constructor Create;override;
    procedure Generate;override;
  published
    property Frequency:integer read FFrequency write SetFrequency;
  end;

  TWhiteNoiseGenerator=class(TBasicToneGenerator)
  private
  public
    procedure Generate;override;
  published
  end;


{======================================
Menghasilkan tone dan menyimpannya ke stream
=======================================}
procedure GenerateToneToStream(Stream:TStream;
                     const Frequency{Hz},
                     Duration{mSec}: Integer;
                    const Volume: TVolumeLevel;
                    const nChannel:TSoundChannel;
                    const Sample_Rate:TSampleRate=sr44_1KHz);

{======================================
Menghasilkan noise dan menyimpannya ke stream
=======================================}
procedure GenerateNoiseToStream(Stream:TStream;
                    const Duration{mSec}: Integer;
                    const Volume: TVolumeLevel;
                    const nChannel:TSoundChannel;
                    const Sample_Rate:TSampleRate=sr44_1KHz);

implementation
uses windows,sysutils,MMSystem;



procedure GenerateToneToStream(Stream:TStream;
                     const Frequency{Hz},
                     Duration{mSec}: Integer;
                    const Volume: TVolumeLevel;
                    const nChannel:TSoundChannel;
                    const Sample_Rate:TSampleRate=sr44_1KHz);
var
  WaveFormatEx: TWaveFormatEx;
  i, sizeByte,TempInt, DataCount, RiffCount: integer;
  SoundValue: byte;
  // w=omega ( 2 * pi * frequency)
  //w_per_samplerate=w/samplerate
  w,w_per_samplerate: double;
  SampleRate:integer;
const
  RiffId: string = 'RIFF';
  WaveId: string = 'WAVE';
  FmtId: string = 'fmt ';
  DataId: string = 'data';
begin
  SampleRate:=GetSampleRate(Sample_Rate);
  if Frequency > (0.6 * SampleRate) then
    raise Exception.Create(Format('Sample rate %d terlalu sedikit untuk memainkan tone %dHz',
                                  [SampleRate, Frequency])
                           );

  with WaveFormatEx do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := GetNumChannels(nChannel);
    nSamplesPerSec := SampleRate;
    wBitsPerSample := $0008;
    nBlockAlign := (nChannels * wBitsPerSample) div 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize := 0;
  end;
  {hitung panjang data sound dan panjang stream WAV yang harus dihasilkan}
  DataCount := (Duration * SampleRate) div 1000; // sound data
  TempInt := SizeOf(TWaveFormatEx);
  RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
               TempInt + Length(DataId) + SizeOf(DWORD) + DataCount; // file data
  {tulis wave header}
  Stream.WriteBuffer(RiffId[1], 4); // 'RIFF'
  Stream.WriteBuffer(RiffCount, SizeOf(DWORD)); // file data size
  Stream.WriteBuffer(WaveId[1], Length(WaveId)); // 'WAVE'
  Stream.WriteBuffer(FmtId[1], Length(FmtId)); // 'fmt '
  Stream.WriteBuffer(TempInt, SizeOf(DWORD)); // TWaveFormat data size
  Stream.WriteBuffer(WaveFormatEx, TempInt); // WaveFormatEx record
  Stream.WriteBuffer(DataId[1], Length(DataId)); // 'data'
  Stream.WriteBuffer(DataCount, SizeOf(DWORD)); // sound data size
  sizeByte:=Sizeof(Byte);
  {hitung dan simpan tone signal ke stream}
  w := 2 * Pi * Frequency; // omega
  w_per_samplerate:=w/SampleRate;
  for i := 0 to DataCount - 1 do
  begin
    SoundValue := 127 + trunc(Volume * sin(i * w_per_SampleRate)); // wt = w * i / SampleRate
    Stream.WriteBuffer(SoundValue, SizeByte);
  end;
end;

{ TBasicToneGenerator }

constructor TBasicToneGenerator.Create;
begin
  FStream:=nil;
  FDuration:=1000;
  FSampleRate:=sr22_05KHz;
  FVolume:=127;
  FChannel:=chMono;
end;

destructor TBasicToneGenerator.Destroy;
begin
  FStream.Free;
  inherited;
end;

procedure TBasicToneGenerator.Generate;
begin
  if FStream=nil then
    FStream:=TMemoryStream.Create;
  FStream.Clear;
end;

procedure TBasicToneGenerator.LoadFromFile(const filename: string);
var afile:TFileStream;
begin
  afile:=TFileStream.Create(filename,fmOpenRead);
  try
    LoadFromStream(afile);
  finally
    afile.Free;
  end;
end;

procedure TBasicToneGenerator.LoadFromStream(Stream: TStream);
begin
  if FStream=nil then
    FStream:=TMemoryStream.Create;
  FStream.Clear;
  FStream.CopyFrom(Stream,0);
end;

procedure TBasicToneGenerator.Play;
begin
  if FStream.Size<>0 then
    PlaySound(FStream.Memory,0, SND_MEMORY or SND_ASYNC);
end;

procedure TBasicToneGenerator.PlaySync;
begin
  if FStream.Size<>0 then
    PlaySound(FStream.Memory,0, SND_MEMORY or SND_SYNC);
end;

procedure TBasicToneGenerator.SaveToFile(const filename: string);
var afile:TFileStream;
begin
  afile:=TFileStream.Create(filename,fmCreate);
  try
    SaveToStream(afile);
  finally
    afile.Free;
  end;
end;

procedure TBasicToneGenerator.SaveToStream(Stream: TStream);
begin
  Stream.Seek(0,soFromBeginning);
  Stream.CopyFrom(FStream,0);
end;


procedure TBasicToneGenerator.SetChannel(const Value: TSoundChannel);
begin
  FChannel := Value;
end;

procedure TBasicToneGenerator.SetDuration(const Value: integer);
begin
  FDuration := Value;
end;


procedure TBasicToneGenerator.SetSampleRate(const Value: TSampleRate);
begin
  FSampleRate := Value;
end;

procedure TBasicToneGenerator.SetVolume(const Value: TVolumeLevel);
begin
  FVolume := Value;
end;

{TToneGenerator}

constructor TToneGenerator.Create;
begin
  inherited Create;
  FFrequency:=1000;
end;

procedure TToneGenerator.Generate;
begin
  inherited;
  GenerateToneToStream(FStream,
                       FFrequency,
                       FDuration,
                       FVolume,
                       FChannel,
                       FSampleRate);
end;

procedure TToneGenerator.SetFrequency(const Value: integer);
begin
  FFrequency := Value;
end;

function random_negative(const value:double):double;
begin
  if random>0.5 then
    result:=-value
  else
    result:=value;
end;

procedure GenerateNoiseToStream(Stream:TStream;
                     const Duration{mSec}: Integer;
                    const Volume: TVolumeLevel;
                    const nChannel:TSoundChannel;
                    const Sample_Rate:TSampleRate=sr44_1KHz);
var
  WaveFormatEx: TWaveFormatEx;
  i, sizeByte,TempInt, DataCount, RiffCount: integer;
  SoundValue: byte;
  SampleRate:integer;
const
  RiffId: string = 'RIFF';
  WaveId: string = 'WAVE';
  FmtId: string = 'fmt ';
  DataId: string = 'data';
begin
  SampleRate:=GetSampleRate(Sample_Rate);

  with WaveFormatEx do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := GetNumChannels(nChannel);
    nSamplesPerSec := SampleRate;
    wBitsPerSample := $0008;
    nBlockAlign := (nChannels * wBitsPerSample) div 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize := 0;
  end;
  {hitung panjang data sound dan panjang stream WAV yang harus dihasilkan}
  DataCount := (Duration * SampleRate) div 1000; // sound data
  TempInt := SizeOf(TWaveFormatEx);
  RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
               TempInt + Length(DataId) + SizeOf(DWORD) + DataCount; // file data
  {tulis wave header}
  Stream.WriteBuffer(RiffId[1], 4); // 'RIFF'
  Stream.WriteBuffer(RiffCount, SizeOf(DWORD)); // file data size
  Stream.WriteBuffer(WaveId[1], Length(WaveId)); // 'WAVE'
  Stream.WriteBuffer(FmtId[1], Length(FmtId)); // 'fmt '
  Stream.WriteBuffer(TempInt, SizeOf(DWORD)); // TWaveFormat data size
  Stream.WriteBuffer(WaveFormatEx, TempInt); // WaveFormatEx record
  Stream.WriteBuffer(DataId[1], Length(DataId)); // 'data'
  Stream.WriteBuffer(DataCount, SizeOf(DWORD)); // sound data size
  sizeByte:=Sizeof(Byte);

  {hitung dan simpan tone signal ke stream}
  for i := 0 to DataCount - 1 do
  begin
    SoundValue := 127 + trunc(Volume * random_negative(random));
    Stream.WriteBuffer(SoundValue, SizeByte);
  end;
end;

{ TWhiteNoiseGenerator }

procedure TWhiteNoiseGenerator.Generate;
begin
  inherited;
  GenerateNoiseToStream(FStream,
                        FDuration,
                        FVolume,
                        FChannel,
                        FSampleRate);
end;


initialization
randomize;
end.

Ok let us discuss core of TToneGenerator class.


procedure GenerateToneToStream(Stream:TStream;
                     const Frequency{Hz},
                     Duration{mSec}: Integer;
                    const Volume: TVolumeLevel;
                    const nChannel:TSoundChannel;
                    const Sample_Rate:TSampleRate=sr44_1KHz);
var
  WaveFormatEx: TWaveFormatEx;
  i, sizeByte,TempInt, DataCount, RiffCount: integer;
  SoundValue: byte;
  // w=omega ( 2 * pi * frequency)
  //w_per_samplerate=w/samplerate
  w,w_per_samplerate: double;
  SampleRate:integer;
const
  RiffId: string = 'RIFF';
  WaveId: string = 'WAVE';
  FmtId: string = 'fmt ';
  DataId: string = 'data';
begin
  SampleRate:=GetSampleRate(Sample_Rate);
  if Frequency > (0.6 * SampleRate) then
    raise Exception.Create(Format('Sample rate %d terlalu sedikit untuk memainkan tone %dHz',
                                  [SampleRate, Frequency])
                           );

  with WaveFormatEx do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := GetNumChannels(nChannel);
    nSamplesPerSec := SampleRate;
    wBitsPerSample := $0008;
    nBlockAlign := (nChannels * wBitsPerSample) div 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize := 0;
  end;
  {hitung panjang data sound dan panjang stream WAV yang harus dihasilkan}
  DataCount := (Duration * SampleRate) div 1000; // sound data
  TempInt := SizeOf(TWaveFormatEx);
  RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
               TempInt + Length(DataId) + SizeOf(DWORD) + DataCount; // file data
  {tulis wave header}
  Stream.WriteBuffer(RiffId[1], 4); // 'RIFF'
  Stream.WriteBuffer(RiffCount, SizeOf(DWORD)); // file data size
  Stream.WriteBuffer(WaveId[1], Length(WaveId)); // 'WAVE'
  Stream.WriteBuffer(FmtId[1], Length(FmtId)); // 'fmt '
  Stream.WriteBuffer(TempInt, SizeOf(DWORD)); // TWaveFormat data size
  Stream.WriteBuffer(WaveFormatEx, TempInt); // WaveFormatEx record
  Stream.WriteBuffer(DataId[1], Length(DataId)); // 'data'
  Stream.WriteBuffer(DataCount, SizeOf(DWORD)); // sound data size
  sizeByte:=Sizeof(Byte);
  {hitung dan simpan tone signal ke stream}
  w := 2 * Pi * Frequency; // omega
  w_per_samplerate:=w/SampleRate;
  for i := 0 to DataCount - 1 do
  begin
    SoundValue := 127 + trunc(Volume * sin(i * w_per_SampleRate)); // wt = w * i / SampleRate
    Stream.WriteBuffer(SoundValue, SizeByte);
  end;
end;

Tone Generator Application Implementation

Ok, let us create a application demo to utilize TToneGenerator class. Create new application and drag drop following controls to make it looks like below. Then flesh out event handler code for Generate and Save button as follow:

Tone generator main form design

Fig.1 Main form design.

{======================================
Tone Generator Demo
=======================================
(c) 2006 zamrony p juhara
=======================================
http://www.juhara.com
=======================================}
unit UfrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,uSoundTypes,uToneGenerator, ExtCtrls;

type
  TfrmMain = class(TForm)
    btnGenerate: TButton;
    edFrequency: TEdit;
    lblFrequency: TLabel;
    edDuration: TEdit;
    lblDuration: TLabel;
    lblHz: TLabel;
    lblMSec: TLabel;
    trckbrVolume: TTrackBar;
    lblVolume: TLabel;
    cmbxSampleRate: TComboBox;
    lblSampleRate: TLabel;
    btnSave: TButton;
    SaveDialog1: TSaveDialog;
    rdgrpChannel: TRadioGroup;
    procedure btnGenerateClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    tone:TToneGenerator;
    { Private declarations }
  public
    constructor Create(AOwner:TComponent);override;
    destructor destroy;override;
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation


{$R *.dfm}

procedure TfrmMain.btnGenerateClick(Sender: TObject);
begin
  tone.Frequency:=strToInt(edFrequency.Text);
  tone.Duration:=strToInt(edDuration.Text);
  tone.Volume:=TVolumeLevel(trckBrVolume.Position);
  tone.SampleRate:=TSampleRate(cmbxSampleRate.ItemIndex);
  if rdgrpChannel.ItemIndex=0 then
    tone.Channel:=chMono
  else
    tone.Channel:=chStereo;

  tone.Generate;
  tone.Play;
  btnSave.Enabled:=true;
end;

constructor TfrmMain.Create(AOwner: TComponent);
begin
  inherited;
  tone:=TToneGenerator.Create;
  btnSave.Enabled:=false;
end;

destructor TfrmMain.destroy;
begin
  tone.Free;
  inherited;
end;

procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    tone.SaveToFile(SaveDialog1.Filename);
end;

end.

Compile and run. Make sure your audio speaker are on. Everytime btnGenerate button is clicked, it will sound tone with frequency defined in edit box. Tone then can be save in WAV file to be played with other audio player.

Source code is available for download here.

Playing WAV with Wave API

Do you like this article? Help this website improve by donating. Any amounts is appreciated.

Or you can help by bookmarking this page. Bookmark this on Delicious

Generating tone with Delphi

Introduction

Tone Generator Implementation

Tone Generator Application Implementation

Related Article