给你一断代码吧，可以实现捕捉声卡的实时音量，你在录音控制里选择你的捕捉对像即可
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
proceduredo
ShowTime;//(Time : Integer);
dynamic;
proceduredo
ShowProgress(position : Integer);
dynamic;
proceduredo
Capture(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^.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 - 1do
begin
x := i;
y := Round(abs(data8^ - 128) * 100 / 128);
//data8^ 为 128 - 256 之间
p^ := Point(x, y);
//计算滤波后的值 , 滤波之后的数据存入 P2 中
if (i > 1) and (i < BufSize ) then
begin
p2^ := Point(p^.X, GetMidValue(i));
end;
//p2^ := GetMidValue(x,y,i);
//Inc(count,data8^);
//count := count + Round(abs(data8^ - 128) * 100 / 128);
//ShowProgress(Round(count / BufSize));
tmp := Round(abs(data8^ - 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.Canvasdo
begin
Brush.Color := clBlack;
Pen.Color := clGreen;
FillRect(ClipRect);
Polyline(Slice(p^, BufSize));
end;
with PaintBox2.Canvasdo
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 - 1do
begin
if abs(p2^.Y ) > FilterValve then
begin
if StartPos = 0 then
StartPos := i;
Inc(SCount);
end else
if StartPos = 0 then
p^.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^.Y := 0;//h div 2;
end;
{
if (SCount > 20) and isCapture then
with PaintBox3.Canvasdo
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
do
ShowTime();
//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;
do
Capture(passTime);
end;
if stop then
WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),
SizeOf(TWaveHdr))
else
stop := true;
do
ShowProgress(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 headerdo
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 BufHeaddo
begin
lpData := Buf;
dwBufferLength := BufLen;
dwFlags := WHDR_begin
LOOP;
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 stopdo
Application.ProcessMessages;
//while not stopdo
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.
使用方法
unit un1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,mmsystem,SoundCap_Unit;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure OnSoundPosition(Sender: TObject;
Position: Integer);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
SoundCap:TSoundCap;
implementation
{$R *.dfm}
procedure TForm1.OnSoundPosition(Sender: TObject;
Position: Integer);
begin
caption:=inttostr(Position);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SoundCap.OpenCapture(self.Handle);
end;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
SoundCap.CloseCapture;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SoundCap := TSoundCap.Create(self.Handle);
SoundCap.OnShowProgress := OnSoundPosition;
// SoundCap.OnShowTime := OnShowTime;
// SoundCap.OnCapture := OnCapture;
end;
