首页  编辑  

声卡模拟PC喇叭发声

Tags: /超级猛料/Multi-Media.多媒体相关/   Date Created:

来自:YB_unique, 时间:2001-12-5 11:00:00, ID:764750

为什么不直接用PC喇叭?声卡模拟发生Beep声音,需要做一个函数序列,通过改变频率来实现。

其实你完全可以做一个Wav资源文件,播放时改变频率即可!

下面给你所需函数,搞定没问题!

PWaveFormatEx = ^TWaveFormatEx;

 tWAVEFORMATEX = packed record

   wFormatTag: Word;

   nChannels: Word;

   nSamplesPerSec: DWORD;

   nAvgBytesPerSec: DWORD;

   nBlockAlign: Word;

   wBitsPerSample: Word;

   cbSize: Word;

 end;

function waveOutOpen(

  lphWaveOut: PHWaveOut;

  uDeviceID: UINT;

  lpFormat: PWaveFormatEx;

  dwCallback, dwInstance,

  dwFlags: DWORD

 ): MMRESULT;

function waveOutWrite(

  hWaveOut: HWAVEOUT;

  lpWaveOutHdr: PWaveHdr;

  uSize: UINT

 ): MMRESULT; stdcall;

function waveOutUnprepareHeader(

   hWaveOut: HWAVEOUT;

   lpWaveOutHdr: PWaveHdr;

   uSize: UINT

  ): MMRESULT; stdcall;

function waveOutClose(

  hWaveOut: HWAVEOUT

 ): MMRESULT; stdcall;

来自:YB_unique, 时间:2001-12-5 11:02:00, ID:764758

完整调用单元如下:

unit Echo1;

interface

uses

 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

 Forms, Dialogs, mmsystem;

const

    {The larger the size of the block the fewer blocks recorded}

    {per second and therefore the longer the delay between}

    {recording and playback}

    memBlockLength = 500;

    {500 bytes at 11k/sec = delay of 500/11000 of a second}

    {roughly a 20th}

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,PWaveFormat(WaveFormat),0,0,WAVE_FORMAT_QUERY);

    if i<>0 then application.messagebox('Error', 'Play format not supported', mb_OK);

    i:=waveInOpen(nil,0,PWaveFormat(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,Pwaveformat(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,Pwaveformat(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;

         {prepare the new block}

         i:=waveInPrepareHeader(HWaveIn^,Header,sizeof(TWavehdr));

         if i<>0 then application.messagebox('In Prepare error','error',mb_ok);

         {add it to the buffer}

         i:=waveInAddBuffer(HWaveIn^,Header,sizeof(TWaveHdr));

         if i<>0 then application.messagebox('Add buffer error','error',mb_ok);

         inc(in_count);

    end; {of loop}

    {finally start recording}

    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);

    {get the returned header}

    Header:=PWaveHdr(msg.lparam);

    i:=waveOutUnPrepareHeader(HWaveOut^,Header,sizeof(TWavehdr));

    if i<>0 then application.messagebox('Out Un Prepare error','error',mb_ok);

    {free the memory}

    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 there's nothing more to do then close}

    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);

    {block has been recorded}

    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

         {prepare it for play back}

         i:=waveOutPrepareHeader(HWaveOut^,Header,sizeof(TWavehdr));

         if i<>0 then application.messagebox('Out Prepare error','error',mb_ok);

         {add it to the playback queue}

         i:=waveOutWrite(HWaveOut^,Header,sizeof(TWaveHdr));

         if i<>0 then application.messagebox('Wave out error','error',mb_ok);

         inc(out_count);

         {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;

         {prepare the new block}

         i:=waveInPrepareHeader(HWaveIn^,Header,sizeof(TWavehdr));

         if i<>0 then application.messagebox('In Prepare error','error',mb_ok);

         {add it to the buffer}

         i:=waveInAddBuffer(HWaveIn^,Header,sizeof(TWaveHdr));

         if i<>0 then application.messagebox('Add buffer error','error',mb_ok);

         inc(in_count);

    end;

    {if there's no more blocks being recorded}

    if (in_count=0) then

    begin

         WaveInClose(HWaveIn);

         HwaveIn:=nil;

    end;

    {if there's nothing more to do then close}

    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.