用waveinopen 录音！！ ( 积分: 100 )

请给出源代码！！

请给出源代码！！

下载acm控件 看看他的源码 原理就明白了

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,mmsystem, StdCtrls;
const
WAVINBUFCOUNT = 3;
WAVOUTBUFCOUNT = 3;
WAVMAXBUFSIZE = 13000;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Label1: TLabel;
GroupBox1: TGroupBox;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
procedure WaveinProc(hwo: HWAVEIN;
uMsg: UINT;
dwParam1,
dwParam2: DWORD);
procedure WaveOutProc(hwo: HWAVEOUT;
uMsg: UINT;
dwParam1,
dwParam2: DWORD);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
var mywaveformat :twaveformatex;
mmr:mmresult;
mywavein:hwavein;
///InBuf1, inBuf2: pchar;
InHdr1: TWaveHdr;
InHdr2: TWaveHdr;
inbuf1,inbuf2: Array[0..90040] of Byte;
///////////////////////////////////
//outdata
// fData: PChar;

var
i: Integer;
hwo: HWAVEOUT;
wfx: TWAVEFORMATEX;
woh: TWAVEHDR;
WaveFormatWaveFormatEX;
//PCMWAVEFORMAT;
//声音类型
cbwic:waveincaps;
///////////////////////////////////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////

implementation
{$R *.dfm}
procedure waveOutPrc(hwo: HWAVEOUT;
uMsg: UINT;
dwInstance,dwParam1, dwParam2: DWORD);
stdcall;
begin

TForm1(dwInstance).WaveOutProc(hwo, uMsg, dwParam1, dwParam2)
end;

procedure waveinPrc(hwo: HWAVEIN;
uMsg: UINT;
dwInstance, dwParam1, dwParam2: DWORD);
stdcall;
begin

TForm1(dwInstance).WaveinProc(hwo, uMsg, dwParam1, dwParam2)
end;



procedure TForm1.Button1Click(Sender: TObject);
var itemp:integer;
begin

mywaveformat.wFormatTag:=WAVE_FORMAT_PCM;
mywaveformat.nChannels:=1;
mywaveformat.nSamplesPerSec:=8000;
mywaveformat.nAvgBytesPerSec:=16000;
mywaveformat.nBlockAlign:=2;
mywaveformat.cbSize:=0;
mywaveformat.wBitsPerSample:=16;
///mmr:=waveinopen(@mywavein,WAVE_MAPPER,@mywaveformat,DWORD(@WaveinPrc),0,WAVE_ALLOWSYNC+CALLBACK_FUNCTION);
mmr:=waveinopen(@mywavein,WAVE_MAPPER,@mywaveformat,DWORD(@WaveinPrc),0,WAVE_ALLOWSYNC+CALLBACK_FUNCTION);



if mmr<>MMSYSERR_NOERROR then

begin


showmessage(vartostr(mmr));
exit;
end ;
begin

showmessage('we have opened sound device');
end;

try
/// getmem(inbuf1,WAVMAXBUFSIZE);
//freemem(inbuf1);

except
application.MessageBox('short of mem','error',MB_OK);
end;

try
/// getmem(inbuf2,WAVMAXBUFSIZE);
//freemem(inbuf1);

except
application.MessageBox('short of mem','error',MB_OK);
end;

inhdr1.lpData:=@inbuf1[0];
inhdr1.dwBufferLength:=90040;
inhdr1.dwBytesRecorded:=0;
inhdr1.dwUser:=0;
inhdr1.dwFlags:=0;
inhdr1.dwLoops:=0;
inhdr1.lpNext:=nil;
inhdr1.reserved:=0;
mmr:=waveinprepareheader(mywavein,@inhdr1,sizeof(inhdr1));
if mmr<>MMSYSERR_NOERROR then

begin

// freemem(inbuf1);
// freemem(inbuf2);
showmessage(vartostr(mmr));
exit;
end;

mmr:=waveinaddbuffer(mywavein,@inhdr1,sizeof(inhdr1));
if mmr<>MMSYSERR_NOERROR then

begin

showmessage('waveinaddbuffer failed');
waveinunprepareheader(mywavein,@inhdr1,sizeof(inhdr1));
/// freemem(inbuf1);
exit;

end;

mmr:=waveinstart(mywavein);
if mmr<>MMSYSERR_NOERROR then

begin

showmessage('can not start');
end;

end;


procedure TForm1.WaveinProc(hwo: HWAVEIN;
uMsg: UINT;
dwParam1,
dwParam2: DWORD);
begin


case uMsg of
MM_WIM_OPEN:
begin

showmessage('WiM_OPEN:');

end;

MM_WIM_DATA:
begin

showmessage('wim_data');

waveinstop(mywavein);

end;

MM_WIM_CLOSE:
begin

/// showmessage('wom_done');

///PostMessage(Handle, WM_FINISHED, 0, 0);
end;

end

end;


procedure TForm1.Button2Click(Sender: TObject);
begin

try
waveinunprepareheader(mywavein,@inhdr1,sizeof(inhdr1));
///freemem(inbuf1);
showmessage('exit recoder');
except
showmessage('dont not exit');
end;


end;


procedure TForm1.Button3Click(Sender: TObject);

begin

wfx:=mywaveformat;
/// if waveOutOpen(@hwo,2,@wfx,DWORD(@WaveOutPrc),Integer(Self) , CALLBACK_FUNCTION) <>
MMSYSERR_NOERROR then

if waveOutOpen(@hwo,WAVE_MAPPER,@wfx,DWORD(@WaveOutPrc),Integer(Self) , CALLBACK_FUNCTION) <>
MMSYSERR_NOERROR then


begin

//fWaveOutHandle := 0;
raise Exception.Create('Failed to open output device');
end;


with wohdo

begin

lpData :=@inbuf1[0];
dwBufferLength := 90040;
dwBytesRecorded := 0;
dwUser := 0;
dwFlags := 0;
dwLoops := 0;
lpNext := nil;
reserved := 0;
end;


waveOutPrepareHeader(hwo,@woh,SizeOf(TWAVEHDR));
waveOutWrite(hwo, @woh, sizeof(TWAVEHDR));
waveOutUnprepareHeader(hwo,@woh,sizeof(TWAVEHDR));
waveOutClose(hwo);



end;


procedure TForm1.WaveOutProc(hwo: HWAVEOUT;
uMsg: UINT;
dwParam1,
dwParam2: DWORD);
begin

case uMsg of
WOM_OPEN:
begin

showmessage('WOM_OPEN:');

end;

WOM_CLOSE:
begin

// fWaveOutHandle := 0;
/// setvolume(64355,64355);
showmessage('wom_close');
end;

WOM_DONE:
begin

showmessage('wom_done');

///PostMessage(Handle, WM_FINISHED, 0, 0);
end;

end
end;

procedure TForm1.Button4Click(Sender: TObject);
begin

///label1.caption:=vartostr( waveInGetDevCaps(WAVE_MAPPER,pwaveincaps,sizeof(cbwic)));
///label1.caption:=vartostr(waveingetdevcaps(wave_mapper,pwaveincaps,sizeof(cbwic)));
label1.Caption:=vartostr(waveingetnumdevs());
end;


procedure TForm1.Button5Click(Sender: TObject);
begin


end;


end.

llll