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.