麦克风测试

Question

想做一个类似qq中测试麦克风的程序，怎么实现给个意见。谢谢

Answer 1

unit uSoundCap;
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.