Bevor man den folgenden Code einsetzen möchte, sollte man sich davon vergewissern, dass die richtigen Soundtreiber für die Soundkarte installiert sind. Viele Systeme nutzen Standardtreiber, bei denen der ganze Stereo-Mix-Bereich nicht vorhanden ist, weil er für eine Wiedergabe von Sound nicht notwendig ist. Dieser ist aber für eine Input-Signalerfassung, wie z. B. für ein Headset, wichtig.
Sollte das der Fall sein, kann mittels dieses Codes das Signal erfasst und als Wave Datei aufgenommen werden. Das Signal wird dann als Grafik veranschaulicht.
Es wird benötigt :1xCheckBox, 3xButton, 1xBitBtn, 2xLabel und eine Image
uses ExtCtrls, ComCtrls, MMSystem, Buttons
public
procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
{ Public declarations }
TData16 = array [0..127] of smallint;
PData16 = ^TData16;
tWaveFileHdr = packed record
riff: array[0..3] of Char;
len: DWord;
cWavFmt: array[0..7] of Char;
dwHdrLen: DWord;
wFormat: Word;
wNumChannels: Word;
dwSampleRate: DWord;
dwBytesPerSec: DWord;
wBlockAlign: Word;
wBitsPerSample: Word;
cData: array[0..3] of Char;
dwDataLen: DWord;
end;
const BufSize=11000;
var
Form1: TForm1;
WaveIn: hWaveIn;
hBuf: THandle;
BufHead: TWaveHdr;
m:array[1..bufSize] of smallInt;
h,w,h2:integer;
zs:boolean=false;
rec:boolean=false;
mz :array of smallInt;
waveHdr:tWaveFileHdr;
qz:integer;
//
procedure iniWav;
begin
WaveHdr.riff:='RIFF';
WaveHdr.cWavFmt:='WAVEfmt ';
WaveHdr.dwHdrLen:=16;
WaveHdr.wFormat:=1;
WaveHdr.wNumChannels:=1;
WaveHdr.dwSampleRate:=11000;
WaveHdr.wBlockAlign:=4;
WaveHdr.dwBytesPerSec:=22000;
WaveHdr.wBitsPerSample:=16;
WaveHdr.cData:='data';
WaveHdr.dwDataLen:=qz*2;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
if zs then exit;
with header do begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 11000;
wBitsPerSample := 16;
nBlockAlign := nChannels * (wBitsPerSample div 8);
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),Form1.Handle, 0, CALLBACK_WINDOW);
BufLen := header.nBlockAlign * BufSize;
hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
Buf := GlobalLock(hBuf);
with BufHead do begin
lpData := Buf;
dwBufferLength := BufLen;
dwFlags := WHDR_BEGINLOOP;
end;
WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
zs:=true;
WaveInStart(WaveIn);
End;
procedure TForm1.Button2Click(Sender: TObject);
begin
if not zs then Exit;
WaveInReset(WaveIn);
WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
WaveInClose(WaveIn);
GlobalUnlock(hBuf);
GlobalFree(hBuf);
zs:=false;
end;
procedure TForm1.OnWaveIn;
var
data16: PData16;
i,d,z,s,x,y,xx,max,s0: integer;
begin
WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),SizeOf(TWaveHdr));
data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
move(data16^[0],m,BufSize*2);
if data16^[0]<>m[1] then showMessage('<>');
s:=0;
s0:=0;
max:=0;
for i := 1 to BufSize do begin
z:=m[i];
inc(s0,z);
z:=abs(z);
inc(s,z);
if z>max then max:=z;
end;
s:=s div bufSize;
s0:=s0 div bufSize;
label1.caption:='Sound: '+intToStr(s)+
', Max: '+intToStr(max)+
', Buffer: '+intToStr(s0);
with form1.image1.Picture.Bitmap.canvas do begin
fillRect(rect(0,0,w,h));
pen.color:=$CCCCCC; moveTo(w,h2); lineTo(0,h2);
pen.color:=0;
max:=abs(max-abs(s0));
if max<16 then max:=16;
if checkBox1.checked then d:=BufSize else d:=w;
for x:=1 to w do begin
xx:=x*BufSize div d;
y:=h2+(m[xx]-s0)*h2 div max;
if x=1 then moveTo(0,y) else lineTo(x,y);
end;
end;
if rec then begin
setLength(mz,qz+bufSize+1);
move(m[1],mz[qz+1],BufSize*2);
inc(qz,BufSize);
form1.label2.caption:=formatFloat('0.00',qz*2/1000000)+' Hz';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
w:=image1.width;
h:=image1.height;
h2:=h div 2;
image1.Picture.Bitmap.width:=w;
image1.Picture.Bitmap.height:=h;
Form1.Button1Click(Sender);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Form1.Button2Click(Sender)
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
winExec('SndVol32.exe /r',SW_SHOW);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var fw:file;
begin
if rec then begin
rec:=false;
if qz>0 then begin
iniWav;
assignFile(fw,'sound.wav');
rewrite(fw,1);
blockWrite(fw,waveHdr,sizeOf(waveHdr));
blockWrite(fw,mz[1],qz*2);
closeFile(fw);
showMessage('File "sound.wav"');
label2.visible:=false;
BitBtn1.caption:='start';
end;
end
else begin
qz:=0;
rec:=true;
label2.visible:=true;
BitBtn1.caption:='Stop';
end;
end;
Keine Kommentare:
Kommentar veröffentlichen