[转载]delphi实现音频捕捉与播放

delphi实现音频捕捉与播放

unit unit1;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, mmsystem, StdCtrls;

const memBlockLength = 500; type Tmemblock = array[0..memblocklength] of byte; PmemBlock = ^TmemBlock;

TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private { Private declarations } HwaveIn : PHWaveIn ; HWaveOut: PHWaveOut ; close_invoked, close_complete : boolean ; in_count, out_count : integer ; procedure MMOutDone(var msg:Tmessage);message MM_WOM_DONE; procedure MMInDone(var msg:Tmessage);message MM_WIM_DATA; public { Public declarations } end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject); var WaveFormat:PPCMWaveFormat; Header:PWaveHdr; memBlock:PmemBlock; i,j:integer; begin WaveFormat:=new(PPCMwaveFormat); with WaveFormat^.wf do begin WFormatTag := WAVE_FORMAT_PCM; {PCM format - the only option!} NChannels:=1; {mono} NSamplesPerSec:=11000; {11kHz sampling} NAvgBytesPerSec:=11000; {we aim to use 8 bit sound so only 11k per second} NBlockAlign:=1; {only one byte in each sample} waveformat^.wBitsPerSample:=8; {8 bits in each sample} end;

 i:=waveOutOpen(nil,0,PWAVEFORMATEX(WaveFormat),0,0,WAVE_FORMAT_QUERY);
 if i <> 0 then application.messagebox('Error', 'Play format not supported', mb_OK);

 i:=waveInOpen(nil,0,PWAVEFORMATEX(WaveFormat),0,0,WAVE_FORMAT_QUERY);
 if i <> 0 then application.messagebox('Error', 'Record format not supported', mb_OK);

 HwaveOut:=new(PHwaveOut);
 i:=waveOutOpen(HWaveOut,0,PWAVEFORMATEX(WaveFormat),form1.handle,0,CALLBACK_WINDOW);
 if i <> 0 then application.messagebox('Error', 'Problem creating play handle', mb_OK);

 HwaveIn:=new(PHwaveIn);
 i:=waveInOpen(HWaveIn,0,PWAVEFORMATEX(WaveFormat),form1.handle,0,CALLBACK_WINDOW);
 if i <> 0 then application.messagebox('Error', 'Problem creating record handle', mb_OK);


 {these are the count of the number of blocks sent to}
 {the audio device}
 in_count:=0;
 out_count:=0;

 {need to add some buffers to the recording queue}
 {in case the messages that blocks have been recorded}
 {are delayed}
 for j:= 1 to 3 do
 begin
      {make a new block}
      Header:=new(PWaveHdr);
      memBlock:=new(PmemBlock);

      Header:=new(PwaveHdr);
      with header^ do
      begin
           lpdata:=pointer(memBlock);
           dwbufferlength:=memblocklength;
           dwbytesrecorded:=0;
           dwUser:=0;
           dwflags:=0;
           dwloops:=0;
      end;


      i:=waveInPrepareHeader(HWaveIn^,Header,sizeof(TWavehdr));
      if i <> 0 then application.messagebox('In Prepare error','error',mb_ok);


      i:=waveInAddBuffer(HWaveIn^,Header,sizeof(TWaveHdr));
      if i <> 0 then application.messagebox('Add buffer error','error',mb_ok);

      inc(in_count);

 end; {of loop}

 {开始记录}
 i:=waveInStart(HwaveIn^);
 if i <> 0 then application.messagebox('Start error','error',mb_ok);

 close_invoked:=false;
 close_complete:=false;

end;

procedure TForm1.MMOutDone(var msg:Tmessage); var Header:PWaveHdr; i:integer; begin dec(out_count); {得到返回的数据} Header:=PWaveHdr(msg.lparam); i:=waveOutUnPrepareHeader(HWaveOut^,Header,sizeof(TWavehdr)); if i<> 0 then application.messagebox('Out Un Prepare error','error',mb_ok);

 {释放}
 dispose(Header^.lpdata);
 dispose(Header);

 {if there's no more blocks being recorded}
 if (out_count=0) then
 begin
      WaveOutClose(HWaveOut^);
      HwaveOut:=nil;
 end;

 {判断是否已经处理完输入和输出队列}
 if (in_count=0) and (out_count=0) then
 begin
      close_complete:=true;
      close;
 end;

end;

procedure TForm1.MMInDone(var msg:Tmessage); var Header:PWaveHdr; memBlock:PmemBlock; i:integer; begin dec(in_count); {得到已经接收的数据块} Header:=PWaveHdr(msg.lparam); i:=waveInUnPrepareHeader(HWaveIn^,Header,sizeof(TWavehdr)); if i<>0 then application.messagebox('In Un Prepare error','error',mb_ok);

 if not(close_invoked) then
 begin
      {装入输出缓存}
      i:=waveOutPrepareHeader(HWaveOut^,Header,sizeof(TWavehdr));
      if i<>0 then application.messagebox('Out Prepare error','error',mb_ok);

      {添加到输出队列中}
      i:=waveOutWrite(HWaveOut^,Header,sizeof(TWaveHdr));
      if i<>0 then application.messagebox('Wave out error','error',mb_ok);
      inc(out_count);

      {定义一个新的缓存块}
      Header:=new(PWaveHdr);
      memBlock:=new(PmemBlock);

      Header:=new(PwaveHdr);
      with header^ do
      begin
           lpdata:=pointer(memBlock);
           dwbufferlength:=memblocklength;
           dwbytesrecorded:=0;
           dwUser:=0;
           dwflags:=0;
           dwloops:=0;
      end;

      {准备波形装入块}
      i:=waveInPrepareHeader(HWaveIn^,Header,sizeof(TWavehdr));
      if i<>0 then application.messagebox('In Prepare error','error',mb_ok);

      {将缓存区发送给波形输入设备}
      i:=waveInAddBuffer(HWaveIn^,Header,sizeof(TWaveHdr));
      if i<>0 then application.messagebox('Add buffer error','error',mb_ok);

      inc(in_count);
 end;

 {队列已经为空}
 if (in_count=0) then
 begin
      WaveInClose(HWaveIn^);
      HwaveIn:=nil;
 end;

 {判断是否已经处理完输入和输出队列}
 if (in_count=0) and (out_count=0) then
 begin
      close_complete:=true;
      close;
 end;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin {reset the output channel} if HWaveOut <> nil then WaveOutReset(HWaveOut^);

 {reset the input channel}
 if HwaveIn<>nil then WaveInReset(HWaveIn^);
 close_invoked:=true;
 canclose:=close_complete;

end;

end.

来源：oschina

链接：https://my.oschina.net/u/582827/blog/4927246