this slowpoke moves

Input Wave Recorder

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

Beliebte Posts

Translate