Генерирование звука определённой частоты, с помощью звуковой карты
Меня бывает спрашивают:
-Васян, как с помощью простой процедуры вывести на выход звуковой карты звук заданной частоты, амплитуды и длительности?
Отвечаю:
Ниже смотри листинг, проще, наверное не предумаешь! (хотя можно через sndPlaySound, но это ненарядно).
Кстати эту программулину можно использовать как камертон на ноту «Ля» (440 Гц.).

скачать пример (2 кб, Delphi7)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses MMSystem;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const kPi=2*pi/44100;
var
Evt:THandle;
Fmt:TWAVEFORMATEX;
Hdr:TWaveHdr;
WO:HWAVEOUT;
Data:Pointer;
i,Size:Integer;
a,hz:single;
v:PSmallInt;
begin
Size:=88200; // задаём длительность 1 сек
GetMem(Data,Size);
hz:=440; // задаём частоту 440 Гц
a:=10000; // задаём амплитуду но не более 32767 иначе будет дисторшн
try
v:=Data;
for i:=0 to 44100 do
begin
v^:=Round(a*sin(i*hz*kPi));
inc(v);
end;
Evt:=CreateEvent(nil,False,False,nil);
ZeroMemory(@Fmt,SizeOf(Fmt));
ZeroMemory(@Hdr,SizeOf(Hdr));
Fmt.wFormatTag:=WAVE_FORMAT_PCM;
Fmt.nChannels:=1;
Fmt.nSamplesPerSec:=44100;
Fmt.wBitsPerSample:=16;
Fmt.cbSize:=SizeOf(Fmt);
Fmt.nBlockAlign:=4;
Fmt.nAvgBytesPerSec:=4*44100;
if waveOutOpen(@WO,0,@Fmt,Evt,0,CALLBACK_EVENT)<>MMSYSERR_NOERROR then exit;
Hdr.lpData:=Data;
Hdr.dwBufferLength:=Size;
waveOutPrepareHeader(WO,@Hdr,SizeOf(Hdr));
ResetEvent(Evt);
waveOutWrite(WO,@Hdr,SizeOf(Hdr));
WaitForSingleObject(Evt,Infinite);
waveOutUnprepareHeader(WO,@Hdr,SizeOf(Hdr));
waveOutClose(WO);
finally
FreeMem(Data,Size);
end;
end;

end.



Hosted by uCoz