Soundkarte Frequenz wieder geben

[Popov]

Keine Ahnung wo ich die Funktion her habe:

Delphi-Quellcode:

unit Unit2;

interface

uses 
  SysUtils, Dialogs, Classes, MMSystem, Windows;

type
  TVolumeLevel = 0..127;

  procedure MakeSound(Frequency{Hz}, Duration{mSec}: Integer; Volume: TVolumeLevel);


implementation

procedure MakeSound(Frequency{Hz}, Duration{mSec}: Integer; Volume: TVolumeLevel);
  {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 
  Mono: Word = $0001; 
  SampleRate: Integer = 11025; // 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 := Mono; 
    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; 

end.

Beispiel:

Delphi-Quellcode:

uses
  Unit2;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 1000 to 2500 do
  begin
    Caption := IntToStr(i);
    MakeSound(i, 200, 60);
  end;
end;