Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 59. - Vytváříme zvuky

Jan Šindelář - 25.9.2002

Vytváříme zvuky

V jednom z předchozích dílů jsme se zabývali načítáním informací ze souboru WAV a dnes se na to podíváme z poněkud opačné stránky, protože budeme tyto zvukové soubory programově vytvářet.

Procedura, která nám k tomu poslouží, na základě požadovaných parametrů vygeneruje příslušný zvuk do souboru WAV, který pak můžete již běžným způsobem přehrát. Mezi parametry procedury patří jednak frekvence zvuku pro oba kanály, dále pak délka vygenerovaného zvuku (či spíše tónu) a konečně jméno výstupního souboru. Do seznamu použitých jednotek ještě přidejte knihovnu MMSystem, kterou budeme potřebovat.

procedure CreateWave(LeftFreq, RightFreq: Single; Duration: Cardinal; const FileName: String);
const
  BitsPerSample = 16;
  NumChannels = 2;
  SampleRate = 44100;
var
  ChunkSize: Integer;
  DataSize: Integer;
  Factor: Single;
  Format: TWaveFormatEx;
  FourCC: array[0..3] of Char;
  I: Integer;
  NumSamples: Integer;
  L: SmallInt;
  R: SmallInt;
  WaveStream: TFileStream;
begin
  WaveStream := TFileStream.Create(FileName, fmCreate);
  try
    FourCC := `RIFF`;
    WaveStream.Write(FourCC, SizeOf(FourCC));
    NumSamples := (SampleRate * Duration) div 1000;
    DataSize := (BitsPerSample shr 3) * NumChannels * NumSamples;
    ChunkSize := DataSize + SizeOf(TWaveFormatEx) + 20;
    WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
    FourCC := `WAVE`;
    WaveStream.Write(FourCC, SizeOf(FourCC));
    FourCC := `fmt `;
    WaveStream.Write(FourCC, SizeOf(FourCC));
    ChunkSize := SizeOf(TWaveFormatEx);
    WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
    with Format do
    begin
      wFormatTag := WAVE_FORMAT_PCM;
      nChannels := NumChannels;
      nSamplesPerSec := SampleRate;
      wBitsPerSample := BitsPerSample;
      nBlockAlign := nChannels * wBitsPerSample shr 3;
      nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
      cbSize := 0
    end;
    WaveStream.Write(Format, SizeOf(Format));
    FourCC := `data`;
    WaveStream.Write(FourCC, SizeOf(FourCC));
    ChunkSize := DataSize;
    WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
    for I := 0 to 999 do
    begin
      Factor := Exp(- 0.005 * (1000 - I));
      L := Round(Factor * 32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
      R := Round(Factor * 32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
      WaveStream.Write(L, SizeOf(L));
      WaveStream.Write(R, SizeOf(R))
    end;
    for I := 1000 to NumSamples - 1001 do
    begin
      L := Round(32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
      R := Round(32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
      WaveStream.Write(L, SizeOf(L));
      WaveStream.Write(R, SizeOf(R))
    end;
    for I := NumSamples - 1000 to NumSamples - 1 do
    begin
      Factor := Exp(0.005 * (NumSamples - 1001 - I));
      L := Round(Factor * 32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
      R := Round(Factor * 32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
      WaveStream.Write(L, SizeOf(L));
      WaveStream.Write(R, SizeOf(R))
    end;
    WaveStream.Position := 0;
  finally
    WaveStream.Free
  end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateWave(500, 100, 1000, `test.wav`);
end;

Pohledem do části konstant zdrojového kódu si můžete všimnout, jaké parametry bude výsledný soubor mít.

Konkrétní příklad použití vidíte hned za procedurou v události OnClick tlačítka, kdy po jeho stisknutí bude vygenerován testovací soubor o délce jedné sekundy s příslušnými parametry pro levý a pravý kanál. Výsledný "zvuk" sice vzdáleně připomíná spíše nějaké vrčení elektromotoru, ale jsem si jist, že při troše experimentování něco zajímavého vytvoříte.