How can I generate continuous tones of varying frequencies?

Question

I want to generate and play a continuous sound with specific frequencies and amplitudes that change over time. I don't want to have a delay between sounds. How can I do this with Delphi or C++ Builder?

Answer 1

This very simple example should get you started.

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows, MMSystem;

type
  TWaveformSample = integer; // signed 32-bit; -2147483648..2147483647
  TWaveformSamples = packed array of TWaveformSample; // one channel

var
  Samples: TWaveformSamples;
  fmt: TWaveFormatEx;

procedure InitAudioSys;
begin
  with fmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := 44100;
    wBitsPerSample := 32;
    nAvgBytesPerSec := nChannels * nSamplesPerSec * wBitsPerSample div 8;
    nBlockAlign := nChannels * wBitsPerSample div 8;
    cbSize := 0;
  end;
end;
                                          // Hz                     // msec
procedure CreatePureSineTone(const AFreq: integer; const ADuration: integer;
  const AVolume: double { in [0, 1] });
var
  i: Integer;
  omega,
  dt, t: double;
  vol: double;
begin
  omega := 2*Pi*AFreq;
  dt := 1/fmt.nSamplesPerSec;
  t := 0;
  vol := MaxInt * AVolume;
  SetLength(Samples, Round((ADuration / 1000) * fmt.nSamplesPerSec));
  for i := 0 to high(Samples) do
  begin
    Samples[i] := round(vol*sin(omega*t));
    t := t + dt;
  end;
end;

procedure PlaySound;
var
  wo: integer;
  hdr: TWaveHdr;
begin

  if Length(samples) = 0 then
  begin
    Writeln('Error: No audio has been created yet.');
    Exit;
  end;

  if waveOutOpen(@wo, WAVE_MAPPER, @fmt, 0, 0, CALLBACK_NULL) = MMSYSERR_NOERROR then
    try

      ZeroMemory(@hdr, sizeof(hdr));
      with hdr do
      begin
        lpData := @samples[0];
        dwBufferLength := fmt.nChannels * Length(Samples) * sizeof(TWaveformSample);
        dwFlags := 0;
      end;

      waveOutPrepareHeader(wo, @hdr, sizeof(hdr));
      waveOutWrite(wo, @hdr, sizeof(hdr));
      sleep(500);

      while waveOutUnprepareHeader(wo, @hdr, sizeof(hdr)) = WAVERR_STILLPLAYING do
        sleep(100);

    finally
      waveOutClose(wo);
    end;


end;


begin

  try
    InitAudioSys;
    CreatePureSineTone(400, 1000, 0.7);
    PlaySound;
  except
    on E: Exception do
    begin
      Writeln(E.Classname, ': ', E.Message);
      Readln;
    end;
  end;

end.

Notice in particular the neat interface you get:

    InitAudioSys;
    CreatePureSineTone(400, 1000, 0.7);
    PlaySound;

Answer 2

By using WaveAudio library it's possible to generate a continous cosinus wave.

I was gonna post some code but I can't figure out how to do it properly so I won't.

But all you need to do is use TLiveAudioPlayer and then override the OnData event.

And also set Async to true if there is no message pump.

• Update in dec 2021, I just came across my answer by chance... so I would like to update it, I used this ASIO library in 2009 I think and later, great library below:*

I would recommend ASIO library for Delphi !

https://sourceforge.net/projects/delphiasiovst/

Using this is super easy, not all files have to be included, start with the main one and add the rest from there, also see the examples.

Ultimately it's as easy as OnSomeEvent/OnSomeBuffer

and then simply filling an array with floating point values.

Don't remember the exact name of the OnEvent but you'll find it easily in the examples.

Another thing to do is set some component to active/true and voila.

The nice thing about ASIO is very low latency, it's even possible to get it down to 50 microseconds or even lower.

It does require an ASIO driver for your sound chip.

ASIO = audio stream input output

API designed by audio engineers !

It probably doesn't get any better than this ! ;)