Delphi中捕获音频函数OnWaveIn的使用小记

    说明，并非给别人看，只是为了防止自己忘记，所以没有写说明与注释之类的，不好意思了。

     上次有个朋友叫我帮忙写一个小程序，用处比较怪。显示图片，并开始计时，当测试者说出图像内容的时候（无需识别具体的语音内容），停止计时。这样循环显示一系列图片，并记录从显示图片，到发出声音的这段时间。据说是研究语言学使用的。于是用Delphi写了一个小程序，其中记录声音，过滤噪音，判断是否发出声音的程序如下：

unit SoundCap_Unit;

interface

uses
    Windows, Messages, MMSystem, Classes, SysUtils, Math, Forms, Controls;

Const
  BufferTime : Real  =   120 ;   //  每次0.120秒   0.120 * 1000

type

  TData8  =  array [ 0 .. 127 ] of  byte ;
  PData8  =   ^ TData8;
  TData16  =  array [ 0 .. 127 ] of smallint;
  PData16  =   ^ TData16;
  TPointArr  =  array [ 0 .. 127 ] of TPoint;
  PPointArr  =   ^ TPointArr;


  TShowProgressEvent  =  procedure (Sender: TObject; Position: Integer) of object;
  TCaptureEvent  =  procedure (Sender: TObject; passTime : Integer) of Object;
  TShowTimeEvent  =  procedure (Sender : TObject; Time : Integer) of Object;

  TSoundCap  =  Class(TCustomControl)

   private
    FOnShowTime : TShowTimeEvent;
    FOnShowProgress : TShowProgressEvent;
    FOnCapture : TCaptureEvent;

    function GetMidValue(i : Integer) : Integer;   // 计算中值
   protected

    procedure DoShowTime; // (Time : Integer); dynamic;
    procedure DoShowProgress(position : Integer); dynamic;
    procedure DoCapture(passTime : DWORD ); dynamic;

   public

    FilterValve : Integer;  // 音频过滤的阀值

    isCapture :  boolean  ;

     // constructor Create(AOwner: TComponent); overload;
    constructor Create(handle : THandle);  // overload;
    destructor Destroy; override;

    procedure OpenCapture(handle : THandle);
    procedure CloseCapture;

    procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
    procedure StartCap;
    procedure StopCap;
    property OnShowTime: TShowTimeEvent read FOnShowTime write FOnShowTime;
    property OnShowProgress: TShowProgressEvent read FOnShowProgress write FOnShowProgress;
    property OnCapture: TCaptureEvent read FOnCapture write FOnCapture;

  end;


implementation

{ TSoundCap }


var
  WaveIn: hWaveIn;
  hBuf: THandle;
  BufHead: TWaveHdr;
  bufsize: integer;
  Bits16:  boolean ;
  p: PPointArr;
  p2 : PPointArr;
  stop:  boolean   =   false ;

  StartTime : DWORD ;
  Count : integer  =   0 ;

constructor TSoundCap.Create(Handle : THandle); // (AOwner: TComponent);
begin
//   ParentWindow := AOwner;
  Inherited Create(nil);
  ParentWindow : =  handle;
  isCapture : =   false ;
  FilterValve : =   3 ;
end;

destructor TSoundCap.Destroy;
begin

  inherited;
  CloseCapture;
end;

// 触发捕获音频事件
procedure TSoundCap.DoCapture(passTime : DWORD );
var
  EndTime : DWORD ;
begin
  EndTime : =  GetTickCount;
   if  Assigned(FOnCapture) then FOnCapture(Self, EndTime  -  StartTime  -  passTime);
end;

// 显示音频强度
procedure TSoundCap.DoShowProgress(position: Integer);
begin
   if  Assigned(FOnShowProgress) then FOnShowProgress(Self, position);
end;

// 显示时间
procedure TSoundCap.DoShowTime; // (Time : Integer);
var
  EndTime : DWORD ;
begin
  EndTime : =  GetTickCount;
   if  Assigned(FOnShowTime) then FOnShowTime(Self, EndTime  -  StartTime);
end;


// 中值过滤
function TSoundCap.GetMidValue(i: Integer): Integer;
var
  v0,v1,v2 : integer;
  h : integer;
  mid : integer;
begin
  h : =   100 ;
  v0 : =  p ^ [i - 2 ].Y;
  v1 : =  p ^ [i - 1 ].Y;
  v2 : =  p ^ [i].Y;

  mid : =  (v0  +  v1  +  v2) div  3 ;
   if  abs(abs(mid)  -  v1)  >  FilterValve  then
    Result : =  mid
  Else  if  abs(mid  -  h / 2 )  <  FilterValve then
    Result : =   0
  Else
    Result : =  v1;
end;


// 处理Wave数据采集
procedure TSoundCap.OnWaveIn(var Msg: TMessage);
var
  data8 : PData8;
  i, x, y : integer;

  StartPos, EndPos, SCount : integer;
  passTime , MaxValue , tmp : Integer;
  dtime : DWORD;
begin
     // DoCapture(0);

    MaxValue : =   0 ;
    Data8 : =  PData8(PWaveHdr(Msg.lParam) ^ .lpData);

     // 将Buffer中采集的数据存入 P 中
     for  i : =   0  to BufSize  -   1   do
    Begin

      x : =  i;
      y : =  Round(abs(data8 ^ [i]  -   128 )  *   100   /   128 );  // data8^[i] 为 128 - 256 之间
      p ^ [i] : =  Point(x, y);

       // 计算滤波后的值 , 滤波之后的数据存入 P2 中
       if  (i  >   1 ) and (i  <  BufSize )  then
      Begin
        p2 ^ [i] : =  Point(p ^ [i].X, GetMidValue(i));
      end;

       // p2^[i] := GetMidValue(x,y,i);
       // Inc(count,data8^[i]);
       // count := count + Round(abs(data8^[i] - 128) * 100 / 128);
       // ShowProgress(Round(count / BufSize));

      tmp : =  Round(abs(data8 ^ [i]  -   128 )  *   100   /   128 );
       if  tmp  >  MaxValue Then
        MaxValue : =  tmp;
       // count := count + tmp;

    End;


    p2 ^ [ 0 ] : =  Point(p ^ [ 0 ].X, GetMidValue( 2 ));
    p2 ^ [ 1 ] : =  Point(p ^ [ 0 ].X, GetMidValue( 2 ));

   // Caption := IntToStr(count div BufSize);

   // 不需要绘画音频曲线
  {
  with PaintBox1.Canvas  do  begin
    Brush.Color : =  clBlack;
    Pen.Color : =  clGreen;

    FillRect(ClipRect);
    Polyline(Slice(p ^ , BufSize));
  end;

  with PaintBox2.Canvas  do  begin
    Brush.Color : =  clBlack;
    Pen.Color : =  clGreen;

    FillRect(ClipRect);
    Polyline(Slice(p2 ^ , BufSize));
  end;
  }

   // 判断是否有超出域值的数据
  StartPos : =   0 ;
  EndPos : =   0 ;
  SCount : =   0 ;
   for  I : =   0  to BufSize  -   1   do
  begin
     if  abs(p2 ^ [i].Y )  >  FilterValve  then
    Begin
       if  StartPos  =   0  then
        StartPos : =  i;
      Inc(SCount);
    end Else  if  StartPos  =   0   then
        p ^ [i].Y : =    0 ; // h div 2;

     if  (SCount  >   20 ) then
       if  (EndPos  =   0 ) then
        EndPos : =  Min((StartPos  +  BufSize div  2  ) , BufSize  -   1 )
      Else  if  EndPos  <  i then
        p ^ [i].Y : =   0 ; // h div 2;

  end;

  {
   if  (SCount  >   20 ) and isCapture then
  with PaintBox3.Canvas  do  begin
    Brush.Color : =  clBlack;
    Pen.Color : =  clGreen;

    FillRect(ClipRect);
    Polyline(Slice(p ^ , BufSize));
    isCapture : =   false ;
    Timer1.Enabled : =   true ;
    passTime : =  Round(StartPos  *  BufferTime  /  BufSize);
    RecordTime(passTime);
  end; }

   // Show Time
  If isCapture  Then DoShowTime();

   // SCount := 100;
   // StartPos := 0;
   // 如果有音频超出阀值，并且正在捕捉，则记录具体时间
  dtime : =  GetTickCount  -  StartTime;
   // 如果说 dtime < 120 , 则这个Buffer不是现在的缓冲内容
   if  (SCount  >   20 ) and isCapture and (dtime  >   120   +   90 ) then
  Begin
    isCapture : =   false ;
     // Timer1.Enabled := true;
    passTime : =  Round((BufSize  -  StartPos)  *  BufferTime  /  BufSize)  +   90 ;
    DoCapture(passTime);
  End;

   if  stop then WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),
      SizeOf(TWaveHdr))
     else  stop : =   true ;

  DoShowProgress(MaxValue);
   // DoCapture(0);
end;

// 打开音频捕捉
procedure TSoundCap.OpenCapture(handle : THandle);
var
  header: TWaveFormatEx;
  BufLen: word;
  buf: pointer;
begin
  BufSize : =   3   *   500   +   100 ; // TrackBar1.Position * 500 + 100;
  Bits16 : =   false ; // CheckBox1.Checked;
  with header  do  begin
    wFormatTag : =  WAVE_FORMAT_PCM;
    nChannels : =   1 ;
    nSamplesPerSec : =   22050 ;
    wBitsPerSample : =  integer(Bits16)  *   8   +   8 ;
    nBlockAlign : =  nChannels  *  (wBitsPerSample div  8  );
    nAvgBytesPerSec : =  nSamplesPerSec  *  nBlockAlign;
    cbSize : =   0 ;
  end;

  WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),
              self.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));
  GetMem(p, BufSize  *  sizeof(TPoint));
  GetMem(p2, BufSize  *  sizeof(TPoint));

  stop : =   true ;
  WaveInStart(WaveIn);
  StartTime : =  GetTickCount;
end;

// 关闭音频捕捉
procedure TSoundCap.CloseCapture;
begin
   if  stop  =   false  then Exit;
  stop : =   false ;
   while  not stop  do  Application.ProcessMessages;
   // while not stop do sleep
  stop : =   false ;
  WaveInReset(WaveIn);
  WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
  WaveInClose(WaveIn);
  GlobalUnlock(hBuf);
  GlobalFree(hBuf);
  FreeMem(p, BufSize  *  sizeof(TPoint));
  FreeMem(p2, BufSize  *  sizeof(TPoint));
end;

// 开始监视捕捉, 并显示时间
procedure TSoundCap.StartCap;
begin
  isCapture : =   true ;
  StartTime : =  GetTickCount;
end;

// 停止监视音频捕捉
procedure TSoundCap.StopCap;
begin
  isCapture : =   false ;
end;

end.

具体调用：

  SoundCap : =  TSoundCap.Create(self.Handle);
  SoundCap.OnShowProgress : =  OnSoundPosition;
  SoundCap.OnShowTime : =  OnShowTime;
  SoundCap.OnCapture : =  OnCapture;
  
  
  SoundCap.OpenCapture(MainForm.Handle);

  ..
  SoundCap.CloseCapture;

转载于:https://www.cnblogs.com/Activer/archive/2006/01/30/324337.html