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

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.