Чтение и запись звука

Все функции чтения и записи звука я выделил в отдельный модуль. Он приведен после текста программы.

При нажатии Button1 создается звуковой файл в памяти (то есть в памяти создается заголовок, затем идут данные - все точно так же, как в обычном wav-файле), сохраняется на диск и одновременно начинает воспроизводиться. Для этого используется функция playsound. Остановить воспроизведение можно кнопкой Button2.

При нажатии Button3 открывается файл ex.wav (если Вы уже нажимали Button1, то он существует). Далее из файла считываются данные и для каждого канала находится средняя громкость. Не уверен, что это самый правильный способ, но здесь за громкость я взял просто среднее арифметическое. Результаты выводятся в заголовок окна. Для каждого канала выводится значение в процентах от максимально возможной громкости.

Теперь о самой структуре данных. Она очень проста. Если канал один, то данные записаны подряд:

первое значение,
второе значение,
третье значение
...

Если же в файле два канала, то они чередуются:

первое значение первого канала, первое значение второго канала, второе значение первого канала, второе значение второго канала, третье значение первого канала, третье значение второго канала, ...

Если файл восьми битный, то каждое значение занимает 1 байт, если шестнадцати битный - 2 байта. Это соответствует типам shortint и smallint соответственно.

В этой программе данные записываются при помощи процедуры GetData. SaveSound вызывает ее для каждого значения. В качестве параметров передаются канал и номер. А возвращаемое значение передается через нетипизированный параметр res. Такой подход позволяет избежать проблем с типами данных.

При чтении все данные копируются в память, а затем находится сумма всех значений для каждого канала. При выводе громкости эти суммы делятся на максимально возможные суммы и умножаются на сто.

Скачать все необходимые для компиляции файлы проекта можно на program.dax.ru.

uses
 MMSystem, wavfile;

procedure
 TForm1.Button1Click(Sender: TObject);
const

  fr = 11025; {Частота в герцах}
  len = 1; {Длина звука в секундах}

  procedure
 GetData(ch: smallint; index: integer; var
 res);
  var

    v: smallint absolute
 res; // конечное значение
    amp: single; // амплитуда
  begin

    if
 ch = 0
      then
 amp := sin(index * 2 * Pi / (fr * len))
      else
 amp := cos(index * 2 * Pi / (fr * len));
    v := round(amp * (random(60000) - 30000));
  end
;

var

  M: TMemoryStream; // поток для хранения информации в памяти
  F: TFileStream; // Поток для созранения файла
begin

  M := nil
; F := nil
;
  try

    M := TMemoryStream.Create;
    randomize;
    SaveSound(M {Куда записывать}, round(fr * len) {len секунд},
      fr {частота}, 16 {16 бит}, 2 {2 каналла}, @GetData);
    // Воспроизведение звука:
    if
 not
 playsound(M.Memory, 0, SND_MEMORY or
 SND_LOOP or
 SND_ASYNC)
      then
 ShowMessage('Can not play the sound');

    F := TFileStream.Create('ex.wav', fmCreate);
    M.Position := 0;
    F.CopyFrom(M, M.Size);
  finally

    M.Free; F.Free;
  end
;
end
;

procedure
 TForm1.Button2Click(Sender: TObject);
begin

  playsound(nil
, 0, 0); // Остановка воспроизведения
end
;

procedure
 TForm1.Button3Click(Sender: TObject);
var

  SampleCount, SamplesPerSec: integer;
  BitsPerSample, Channeles: smallint;
  F: TFileStream;
  Volume: array
 [0..1] of
 single;
  ToPercent: single;
  buf: pointer;
  buf8: ^shortint;
  buf16: ^smallint;
  i, ch: integer;
begin

  F := nil
; buf := nil
;
  try

    Volume[0] := 0; Volume[1] := 0;
    F := TFileStream.Create('ex.wav', fmOpenRead);
    ReadWaveHeader(F, SampleCount, SamplesPerSec,
      BitsPerSample, Channeles);

    // Чтение данных:
    GetMem(buf, SampleCount * Channeles * BitsPerSample);
    F.Read
(buf^, SampleCount * Channeles * BitsPerSample);
    if
 BitsPerSample = 8 then
 begin

      buf8 := buf;
      for
 i := 0 to
 SampleCount - 1 do

        for
 ch := 0 to
 Channeles - 1 do
 begin

          Volume[ch] := Volume[ch] + abs(buf8^);
          inc(buf8); // Переход к следующему элементу
        end

    end
 else
 begin

      buf16 := buf;
      for
 i := 0 to
 SampleCount - 1 do

        for
 ch := 0 to
 Channeles - 1 do
 begin

          Volume[ch] := Volume[ch] + abs(buf16^);
          inc(buf16); // Переход к следующему элементу
        end
;
    end
;

    // Вывод результатов:
    ToPercent := (1 shl
 BitsPerSample) / 100 * SampleCount;
    if
 Channeles = 1
      then
 Form1.Caption := Format('volume: %2.2f%%',
        [Volume[0] / ToPercent])
      else
 Form1.Caption := Format('left: %2.2f%%, right: %2.2f%%',
        [Volume[0] / ToPercent, Volume[1] / ToPercent]);
  finally

    F.Free;
    FreeMem(buf);
  end
;
end
;

--------------------------------------------------------------------------------

unit
 wavfile;

interface


uses
 classes, sysutils;

type

  TWaveHeader = record

    idRiff: array
 [0..3] of
 char;
    RiffLen: longint;
    idWave: array
 [0..3] of
 char;
    idFmt: array
 [0..3] of
 char;
    InfoLen: longint;
    WaveType: smallint;
    Ch: smallint;
    Freq: longint;
    BytesPerSec: longint;
    align: smallint;
    Bits: smallint;
  end
;

  TDataHeader = record

    idData: array
 [0..3] of
 char;
    DataLen: longint;
  end
;

  TGetData = procedure
(ch: smallint; index: integer; var
 res);
  TSetData = procedure
(ch: smallint; index: integer; data: smallint);

procedure
 CreateWaveHeader(SampleCount, SamplesPerSec: integer;
  BitsPerSample, Channeles: smallint; var
 WaveHeader: TWaveHeader;
  var
 DataHeader: TDataHeader);
procedure
 ReadWaveHeader(Stream: TStream;
  var
 SampleCount, SamplesPerSec: integer;
  var
 BitsPerSample, Channeles: smallint);
procedure
 SaveSound(Stream: TStream; SampleCount, SamplesPerSec: integer;
  BitsPerSample, Channeles: smallint; GetData: TGetData);

implementation


procedure
 Creat
  BitsPerSample, Channeles: smallint; var
 WaveHeader: TWaveHeader;
  var
 DataHeader: TDataHeader);
var

  len: integer;
begin

  if
 (SampleCount <  0) or
 (SamplesPerSec <  1) or

    (not
 BitsPerSample in
 [8, 16]) or

    (not
 Channeles in
 [1, 2])
    then
 raise
 Exception.Create('Wrong params');

  len := SampleCount * BitsPerSample div
 8 * Channeles;
  with
 WaveHeader do
 begin

    idRiff := 'RIFF';
    RiffLen := len + 38;
    idWave := 'WAVE';
    idFmt := 'fmt ';
    InfoLen := 16;
    WaveType := 1;
    Ch := Channeles;
    Freq := SamplesPerSec;
    BytesPerSec := SamplesPerSec * BitsPerSample div
 8 * Channeles;
    align := Channeles * BitsPerSample div
 8;
    Bits := BitsPerSample;
  end
;
  with
 DataHeader do
 begin

    idData := 'data';
    DataLen := len;
  end
;
end
;

procedure
 ReadWaveHeader(Stream: TStream;
  var
 SampleCount, SamplesPerSec: integer;
  var
 BitsPerSample, Channeles: smallint);
var

  WaveHeader: TWaveHeader;
  DataHeader: TDataHeader;
begin

  Stream.Read
(WaveHeader, sizeof(TWaveHeader));
  with
 WaveHeader do
 begin

    if
 idRiff < >  'RIFF' then
 raise
 EReadError.Create('Wrong idRIFF');
    if
 idWave < >  'WAVE' then
 raise
 EReadError.Create('Wrong idWAVE');
    if
 idFmt < >  'fmt ' then
 raise
 EReadError.Create('Wrong idFmt');
    if
 WaveType < >  1 then
 raise
 EReadError.Create('Unknown format');
    Channeles := Ch;
    SamplesPerSec := Freq;
    BitsPerSample := Bits;
    Stream.Seek(InfoLen - 16, soFromCurrent);
  end
;
  Stream.Read
(DataHeader, sizeof(TDataHeader));
  if
 DataHeader.idData = 'fact' then
 begin

    Stream.Seek(4, soFromCurrent);
    Stream.Read
(DataHeader, sizeof(TDataHeader));
  end
;
  with
 DataHeader do
 begin

    if
 idData < >  'data' then
 raise
 EReadError.Create('Wrong idData');
    SampleCount := DataLen div
 (Channeles * BitsPerSample div
 8)
  end
;
end
;

procedure
 SaveSound(Stream: TStream; SampleCount, SamplesPerSec: integer;
  BitsPerSample, Channeles: smallint; GetData: TGetData);
var

  WaveHeader: TWaveHeader;
  DataHeader: TDataHeader;
  buf: smallint;
  BytesPerSample: smallint;
  i: integer;
begin

  CreateWaveHeader(SampleCount, SamplesPerSec, BitsPerSample,
    Channeles, WaveHeader, DataHeader);
  Stream.Write(WaveHeader, sizeof(TWaveHeader));
  Stream.Write(DataHeader, sizeof(TDataHeader));
  BytesPerSample := BitsPerSample div
 8;
  if
 Channeles = 1
  then

    for
 i := 0 to
 SampleCount - 1 do
 begin

      GetData(0, i, buf);
      Stream.Write(buf, BytesPerSample);
    end

  else

    for
 i := 0 to
 SampleCount - 1 do
 begin

      GetData(0, i, buf);
      Stream.Write(buf, BytesPerSample);
      GetData(1, i, buf);
      Stream.Write(buf, BytesPerSample);
    end
;
end
;

end
.

Другое по теме:

• Как воспроизвести wav-файл из ресурса (в EXE)
• Работа с микрофоном
• Изменение громкости