声卡模拟PC喇叭发声

  • 主题发起人 主题发起人 import
  • 开始时间 开始时间
I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
来自: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.
 
 
 

Similar threads

I
回复
0
查看
485
import
I
I
回复
0
查看
620
import
I
I
回复
0
查看
563
import
I
I
回复
0
查看
472
import
I
I
回复
0
查看
632
import
I
后退
顶部