Delphi 音频波形 仅适用于PCI格式

unit Unit2;
interface
uses
Windows, Messages, MMSystem, Classes, SysUtils, Math, Forms, Graphics, Controls;
type
TData8 = array[0..127] of byte;
PData8 = ^TData8;
TPointArr = array[0..127] of TPoint;
PPointArr = ^TPointArr;
TSoundCap = class(TCustomControl)
private
   function GetMidValue(i: Integer): Integer; //计算中值
public
   FilterValve: Integer; //音频过滤的阀值 3
   isCapture: boolean;
   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;
end;
implementation
uses unit1;
{ TSoundCap }

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

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;

//中值过滤

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;
MaxValue, tmp: Integer;

begin
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;

   //计算最大值
   tmp := Round(abs(data8^[i] - 128) * 100 / 128);
   if tmp > MaxValue then
   MaxValue := tmp;
end;

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

//绘画音频曲线

with form1.PaintBox1.Canvas do begin
   Brush.Color := clBlack;
   Pen.Color := clGreen;
   FillRect(ClipRect);
   Polyline(Slice(p^, BufSize));
end;

with form1.PaintBox2.Canvas do begin
   Brush.Color := clBlack;
   Pen.Color := clGreen;
   FillRect(ClipRect);
   Polyline(Slice(p2^, BufSize));
end;

if stop then WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),
   SizeOf(TWaveHdr))
else stop := true;
//强度指示
form1.pb1.Position := MaxValue;
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);
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;
end;

//停止监视音频捕捉

procedure TSoundCap.StopCap;
begin
isCapture := false;
end;

end.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,unit2, StdCtrls, ComCtrls, ExtCtrls;

type
TForm1 = class(TForm)
   Button1: TButton;
   pb1: TProgressBar;
   Button2: TButton;
   PaintBox1: TPaintBox;
   PaintBox2: TPaintBox;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
private

SoundCap : TSoundCap;
   { Private declarations }
public
   { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin
SoundCap := TSoundCap.Create(self.Handle);
SoundCap.OpenCapture(self.Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SoundCap.CloseCapture;
end;

end.