Generating Tone with Delphi

Zamrony P. Juhara

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:

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.