#

Генерация и воспроизведение звука в среде Lazarus (язык pascal)

В данной статье рассмотрим решение задачи создания генератора звука.
Решаемые задачи:
1. Организация алгоритма изменения параметров звука;
2. Управление громкостью;
3. Вывод звука через аудио плату.

Сделано в последней на данный момент версии Lazarus 2.0.8 (в других вервиях возможны незначительное изменения).

Задачей будет ввод частоты импульса, длительности импульса, периода повторения и громкости (амплитуды). 

Вначале необходимо создать пустой проект и настроить его в меню Проект -> Параметры проекта. 
Сохранить проект в отдельной папке: Проект -> Сохранить проект как…
На форму поместить следующие элементы:
1. TLabel (из палитры Standart)- для подписей «Частота», «Длительность», «Амплитуда», «Правый», «Левый», «Период импульсов» (нужно изменить свойство Caption)
2. TSpinEdit (из палитры Misc) — для ввода целочисленных параметров:
    Частоты импульсов TSpinEdit1 (свойства: Value: 1000 (текущая частота в Гц), MinValue:20 (минимальная звуковая частота в Гц), MaxValue: 20000 (максимальная звуковая частота в Гц))  
    Длительности импульсов TSpinEdit2 (свойства: Value: 200 (текущее значение длительности импульса в мс), MinValue:1 (минимальная длительность импульса в мс), MaxValue: 1000 (максимальная длительность импульса в мс))
    Амплитуды импульсов TSpinEdit3 (свойства: Value: 128 (текущая громкость), MinValue:0 (минимальная громкость), MaxValue: 128 (максимальная громкость))
    Амплитуды Правого канала TSpinEdit4 (свойства: Value: 30000 (текущая амплитуда правого канала), MinValue:0 (минимальная амплитуда правого канала), MaxValue: 65000 (максимальная амплитуда правого канала), Increment: 500 (шаг изменения амплитуды для удобства))
    Амплитуды Левого канала TSpinEdit5 (свойства: Value: 30000 (текущая амплитуда левого канала), MinValue:0 (минимальная амплитуда левого канала), MaxValue: 65000 (максимальная амплитуда левого канала), Increment: 500 (шаг изменения амплитуды для удобства))
3. TTrackBar (из палитры Common Controls) — для регулирования значения периода следования импульсов в мс (свойства: Position: 1000 (текущее), Min: 1 (минимальная длительность 1 мс), Max: 2000 (максимальная длительность 2 секунды))
4. TButton (из палитры Standart) — для кнопок «Запуск» (Button1) и «Остановка» (Button2). Названия меняются в свойстве Caption.   
5. TTimer (из палитры System) — для задания периода генерации импульсов (свойства: Enabled: False (пока отключить))

Должно получиться так: 

Генерация и воспроизведение звука в среде Lazarus (язык pascal)

Теперь нужно создать обработку событий в исходном коде программы.
Понадобятся три процедуры:
1. Кнопка Запуск procedure TForm1.Button1Click(Sender: TObject); 
На форме совершить двойное нажатие на кнопку Button1
2. Кнопка procedure TForm1.Button2Click(Sender: TObject);
На форме совершить двойное нажатие на кнопку Button2
3. Сработал таймер procedure TForm1.Timer1Timer(Sender: TObject);
На форме совершить двойное нажатие на элемент Timer1.
Данные функции автоматически создаются средой.

Для реализации функций подключения к звуковой плате, можно воспользоваться готовыми функциями из библиотеки drkb.ru:
1. Воспроизведение звука 
procedure MakeSound(Frequency {Hz}, Duration {mSec}: integer; Volume:integer);
Frequency — задает частоту сигнала целочисленной переменной в Гц, 
Duration — задает длительность импульса целочисленной переменной в мсек,
Volume — задает громкость целочисленной переменной.
2. Установка громкости каждого канала 
procedure SetVolume(const volL, volR: Word);
volL — задает амплитуду левого канала целочисленной переменной,
volR — задает амплитуду правого канала целочисленной переменной.
Они используют модуль MMSystem, поэтому его нужно добавить в раздел uses.

Получаем следующий шаблон в разделе implementation

implementation

{$R *.lfm}
uses
  MMSystem;

// Проигрывание звука
procedure MakeSound(Frequency {Hz}, Duration {mSec}: integer; Volume:integer);
{writes tone to memory and plays it}
var
  WaveFormatEx: TWaveFormatEx;
  MS: TMemoryStream;
  i, TempInt, DataCount, RiffCount: integer;
  SoundValue: byte;
  w: double; // omega ( 2 * pi * frequency)
const
  stereo:Word = $0002;
  SampleRate: Integer = 44100; // 8000, 11025, 22050, or 44100
  RiffId: string = 'RIFF';
  WaveId: string = 'WAVE';
  FmtId: string = 'fmt ';
  DataId: string = 'data';
begin
  if Frequency > (0.6 * SampleRate) then
  begin
    ShowMessage(Format('Sample rate of %d is too Low to play a tone of %dHz',
      [SampleRate, Frequency]));
    Exit;
  end;
  with WaveFormatEx do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := stereo;
    nSamplesPerSec := SampleRate;
    wBitsPerSample := $0008;
    nBlockAlign := (nChannels * wBitsPerSample) div 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize := 0;
  end;
  MS := TMemoryStream.Create;
  with MS do
  begin
    {Calculate length of sound data and of file data}
    DataCount := (Duration * SampleRate) div 1000; // sound data
    RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
      SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount;
        // file data
    {write out the wave header}
    Write(RiffId[1], 4); // 'RIFF'
    Write(RiffCount, SizeOf(DWORD)); // file data size
    Write(WaveId[1], Length(WaveId)); // 'WAVE'
    Write(FmtId[1], Length(FmtId)); // 'fmt '
    TempInt := SizeOf(TWaveFormatEx);
    Write(TempInt, SizeOf(DWORD)); // TWaveFormat data size
    Write(WaveFormatEx, SizeOf(TWaveFormatEx)); // WaveFormatEx record
    Write(DataId[1], Length(DataId)); // 'data'
    Write(DataCount, SizeOf(DWORD)); // sound data size
    {calculate and write out the tone signal}// now the data values
    w := 2 * Pi * Frequency; // omega
    for i := 0 to DataCount - 1 do
    begin
      SoundValue := 127 + trunc(Volume * sin(i * w / SampleRate));
        // wt = w * i / SampleRate
      Write(SoundValue, SizeOf(Byte));
    end;
    {now play the sound}
    sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC);
    MS.Free;
  end;
end;
 // Установка громкости правого и левого канала
 procedure SetVolume(const volL, volR: Word);
 var
   hWO: HWAVEOUT;
   waveF: TWAVEFORMATEX;
   vol: DWORD;
 begin
   // init TWAVEFORMATEX
  FillChar(waveF, SizeOf(waveF), 0);
   // open WaveMapper = std output of playsound
  waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
   vol := volL + volR shl 16;
   // set volume
  waveOutSetVolume(hWO, vol);
   waveOutClose(hWO);
 end;

{ TForm1 }
//Кнопка Запуск
procedure TForm1.Button1Click(Sender: TObject);
begin

end;
//Кнопка Остановка
procedure TForm1.Button2Click(Sender: TObject);
begin
   
end;
//Сработал таймер
procedure TForm1.Timer1Timer(Sender: TObject);
begin

end;                                   

Для хранения параметров импульсов необходимо задать глобальные переменные в в разделе var. Можно обойтись без них, но для удобства чтения кода оставим так.

var
  Form1: TForm1;
  Frq: Integer;   // Частота
  ImpLen: Integer;// Длительность импульса
  Vol: Integer;   // Амплитуда импульса  

Теперь нужно определить алгоритм работы. Например, программа после нажатия кнопки запуск будет запускать таймер и через определенный момент времени он будет получать параметры импульса из полей на форме и воспроизводить его.

Задаем алгоритм Запуска:

//Кнопка Запуск
procedure TForm1.Button1Click(Sender: TObject);
begin
  // Установка введенных параметров генерации
  Timer1.Interval:=TrackBar1.Position; // Установка периода следования импульсов
  Timer1.Enabled:= True; // Запуск прерывания таймера
end; 

Задаем алгоритм Остановки:

//Кнопка Остановка
procedure TForm1.Button2Click(Sender: TObject);
begin
     Timer1.Enabled:=False; // Отключение прерывания таймера
end;  

Задаем алгоритм обработки таймера:

//Сработал таймер
procedure TForm1.Timer1Timer(Sender: TObject);
begin
     Frq:=SpinEdit1.Value; // Установка частоты сигнала
     ImpLen:= SpinEdit2.Value;// Установка длительности импульсов
     Vol :=  SpinEdit3.Value; //Установка амплитуды звука
     SetVolume(SpinEdit5.Value, SpinEdit4.Value); // Установка громкости левого и правого каналов
     Timer1.Interval:=TrackBar1.Position; // Изменение периода следования импульсов
     MakeSound(Frq, ImpLen, Vol); // Воспроизвести импульс
end; 

Проверяем программу:
Задаем параметры на форме:

Генерация и воспроизведение звука в среде Lazarus (язык pascal)

Подключаем наушники и к левому микрофон. (можно и без него) Запускаем программу записи и визуализации звука и нажимаем кнопку Запуск. 
Можно наблюдать следующий сигнал генерации:

Генерация и воспроизведение звука в среде Lazarus (язык pascal)

Если приблизить этот сигнал, то можно увидеть, что импульс состоит из колебаний синусоидальной формы:

Генерация и воспроизведение звука в среде Lazarus (язык pascal)

Можно менять значения во время работы и получить амплитудные и частотные модуляция сложной формы:

Генерация и воспроизведение звука в среде Lazarus (язык pascal)

При возникновении вопросов, пишите в комментариях здесь или в сообществе ВК!

(с) Роман Исаков