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.