1,183
社区成员
发帖
与我相关
我的任务
分享
Canvas.Pen.Color := clLime;
Canvas.MoveTo(0, PArrayBuf(hdr.lpData)^[0]);
for i := 0 to hdr^.dwBytesRecorded - 1 do
begin
Canvas.lineTo(round(r * i), PArrayBuf(hdr.lpData)^[i]);
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,ShellAPI, StdCtrls,MMSystem, ComCtrls ,math;
type
TArrayBuf = array[0..10239] of byte; //1 KByte
PArrayBuf = ^TArrayBuf;
TForm3 = class(TForm)
Button1: TButton;
Image1: TImage;
ProgressBar1: TProgressBar;
ProgressBar2: TProgressBar;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Label3Click(Sender: TObject);
private
hWaveIn: HWaveIn;
WaveFormat: TWaveFormatEx; //Wave_audio数据格式
public
procedure Meter_vu();
procedure WNDPROC(var msg: TMessage); override;
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
begin
Meter_vu();
Button1.Enabled := False;
end;
procedure TForm3.Meter_vu;
var
i: integer;
WaveHdr: PWaveHdr;
DaBuffer: PArrayBuf;
iError : integer;
begin
WaveFormat.wFormatTag := WAVE_FORMAT_PCM;
WaveFormat.nChannels := 1; //MONO
WaveFormat.nSamplesPerSec := 8000; //采样为8k,44100
WaveFormat.nAvgBytesPerSec := 8000;
WaveFormat.nBlockAlign := 1;
WaveFormat.wBitsPerSample := 8;
iError := WaveInOpen(@hWaveIn, 0, @WaveFormat, handle, 0, CALLBACK_WINDOW);
if iError <> 0 then
begin
ShowMessage('err WaveInOpen');
Exit;
end;
//创建8个buffer
for i := 1 to 8 do
begin
DaBuffer := new(PArrayBuf);
WaveHdr := new(PWaveHdr);
with WaveHdr^ do
begin
lpData := pointer(DaBuffer);
dwBufferLength := sizeof(DaBuffer); //1024 = 1 KByte
dwBytesRecorded := 0;
dwUser := 0;
dwFlags := 0;
dwLoops := 0;
end;
iError := WaveInPrepareHeader(hWaveIn, WaveHdr, sizeOf(TWaveHdr));
if iError <> 0 then
begin
ShowMessage('Error WaveInPrepareHeader! ');
Exit;
end;
iError := WaveInAddBuffer(hWaveIn, WaveHdr, Sizeof(TWaveHdr));
if iError <> 0 then
begin
ShowMessage('Error WaveInAddBuffer! ');
Exit;
end;
end;
iError := WaveInStart(hWaveIn);
if (iError <> 0) then
begin
ShowMessage('Error , WaveInStart');
end;
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
if not Button1.Enabled then
begin
WaveInStop(hWaveIn); //Stop
WaveInReset(hWaveIn);
WaveInClose(hWaveIn);
end;
end;
procedure TForm3.WNDPROC(var msg: TMessage);
var
Hdr: PWaveHdr;
i: integer;
r: real;
tt: Integer;
vVal , vVal_temp: Integer;
begin
inherited;
case msg.Msg of
MM_WIM_DATA:
begin
vVal := 0;
Hdr := PWaveHdr(msg.LParam);
if hdr^.dwBytesRecorded > 0 then
begin
r := Image1.ClientWidth / hdr^.dwBytesRecorded;
end
else
r := 0;
PatBlt(Image1.Canvas.Handle, 0, 0, Image1.ClientWidth, Image1.ClientHeight, BLACKNESS);
with Image1 do
begin
Canvas.Pen.Color := clRed;
Canvas.MoveTo(0, 127);
Canvas.LineTo(ClientWidth, 127);
Canvas.Pen.Color := clMaroon;
Canvas.MoveTo(round(r * 100), 0);
Canvas.LineTo(round(r * 100), 255);
Canvas.MoveTo(round(r * 200), 0);
Canvas.LineTo(round(r * 200), 255);
Canvas.MoveTo(round(r * 300), 0);
Canvas.LineTo(round(r * 300), 255);
Canvas.MoveTo(round(r * 400), 0);
Canvas.LineTo(round(r * 400), 255);
Canvas.MoveTo(round(r * 500), 0);
Canvas.LineTo(round(r * 500), 255);
Canvas.MoveTo(round(r * 600), 0);
Canvas.LineTo(round(r * 600), 255);
Canvas.MoveTo(round(r * 700), 0);
Canvas.LineTo(round(r * 700), 255);
Canvas.MoveTo(round(r * 800), 0);
Canvas.LineTo(round(r * 800), 255);
Canvas.MoveTo(round(r * 900), 0);
Canvas.LineTo(round(r * 900), 255);
Canvas.MoveTo(round(r * 1000), 0);
Canvas.LineTo(round(r * 1000), 255);
Canvas.MoveTo(round(r * 1100), 0);
Canvas.LineTo(round(r * 1100), 255);
Canvas.MoveTo(round(r * 1200), 0);
Canvas.LineTo(round(r * 1200), 255);
Canvas.Pen.Color := clLime;
Canvas.MoveTo(0, PArrayBuf(hdr.lpData)^[0]);
for i := 0 to hdr^.dwBytesRecorded - 1 do
begin
Canvas.lineTo(round(r * i), PArrayBuf(hdr.lpData)^[i]);
//取样本中的峰值峰值,实际上取样本一个点也可
vVal_temp := PArrayBuf(hdr.lpData)^[i];
if vVal_temp > vVal then
vVal := vVal_temp;
end;
end;
//采用八位采集样本最大分贝是48dB
try
//取样本数据一个点也可,在8位声道[0]中表示左声道
vVal := PArrayBuf(hdr.lpData)^[0];
vVal := vVal - 127; //取振幅正值
if vVal < 0 then
vVal := abs(vVal);
if vVal = 0 then
vVal := 1;
//这是按db来处理的
tt := round(100/48 * (20 * log10(vVal / 256) + 48 ));
ProgressBar1.Position := tt;
//右声道
vVal := PArrayBuf(hdr.lpData)^[1];
Dec(vVal, 127);
vVal := abs(vVal);
if vVal = 0 then vVal := 1;
tt := round(100 /48 * (20 * log10(vVal / 256) + 48 ));
ProgressBar2.Position := tt;
except
end;
WaveInUnprepareHeader(hWaveIn, hdr, Sizeof(TWaveHdr));
Dispose(Hdr.lpData);
DisPose(Hdr);
Hdr := new(PWaveHdr);
Hdr^.lpData := pointer(new(PArrayBuf));
Hdr^.dwBufferLength := 1024;
Hdr^.dwBytesRecorded := 0;
Hdr^.dwUser := 0;
Hdr^.dwFlags := 0;
Hdr^.dwLoops := 0;
WaveInPrepareHeader(hWaveIn, Hdr, Sizeof(TWaveHdr));
WaveInAddBuffer(hWaveIn, Hdr, Sizeof(TWaveHdr));
end;
end;
end;
procedure TForm3.Label3Click(Sender: TObject);
begin
ShellExecute(Handle, 'Open', 'IEXPLORE.EXE',PChar(label3.Caption), '', SW_SHOWNORMAL);
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, MPlayer, AppEvnts;
type
TWavHeader = record //定义一个Wav文件头格式
rId : longint;
rLen : longint;
wId : longint;
fId : longint;
fLen : longint;
wFormatTag : word;
nChannels : word;
nSamplesPerSec : longint;
nAvgBytesPerSec : longint;
nBlockAlign : word;
wBitsPerSample : word;
dId : longint;
wSampleLength : longint;
end;
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
BtStart: TButton;
BtStop: TButton;
ApplicationEvents1: TApplicationEvents;
Label1: TLabel;
procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);//自定义写一个Wav文件头过程
procedure BtStartClick(Sender: TObject);
procedure BtStopClick(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CreateWav( channels:word; { 1(单声)或者2(立体声)} resolution:word; { 8或者16,代表8位或16位声音}
rate:longint;{声音频率,如11025,22050,44100} fn:string{对应的文件名称} );
var
wf : file of TWavHeader;
wh : TWavHeader;
begin
wh.rId := $46464952;
wh.rLen := 36;
wh.wId := $45564157;
wh.fId := $20746d66;
wh.fLen := 16;
wh.wFormatTag := 1;
wh.nChannels := channels;
wh.nSamplesPerSec := rate;
wh.nAvgBytesPerSec := channels*rate*(resolution div 8);
wh.nBlockAlign := channels*(resolution div 8);
wh.wBitsPerSample := resolution;
wh.dId:=$61746164;
wh.wSampleLength := 0;
assignfile(wf,fn); {打开对应文件 }
rewrite(wf); {移动指针到文件头}
write(wf,wh); {写进文件头 }
closefile(wf); {关闭文件 }
end;
procedure TForm1.BtStartClick(Sender: TObject);
begin
try //在程序当前目录下创建一个Wav文件Temp.wav
CreateWav(1, 16, 40000, (ExtractFilePath(Application.ExeName)+'Temp.wav '));
MediaPlayer1.DeviceType := dtAutoSelect;
MediaPlayer1.FileName := (ExtractFilePath(Application.ExeName)+ 'Temp.wav ');
MediaPlayer1.Open;
MediaPlayer1.StartRecording;
BtStart.Enabled:=false;
BtStop.Enabled:=true;
except
BtStart.Enabled:=True;
BtStop.Enabled:=false;
Application.MessageBox( '媒体设备初始化失败! ', '错误 ',MB_ICONERROR+MB_OK);
end;
end;
procedure TForm1.BtStopClick(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Save;
MediaPlayer1.Close;
Application.MessageBox( '声音录制完毕! ', '信息 ',MB_ICONINFORMATION+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
except
Application.MessageBox( '保存声音文件出错! ', '错误 ',MB_ICONERROR+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
end;
end;
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if (Msg.message >=WM_MOUSEMOVE) and (Msg.message<=WM_MOUSELAST) then
Label1.Caption:= '鼠标有动作'
else if (Msg.message>=WM_KEYFIRST) and (Msg.message<=WM_KEYLAST) then
Label1.Caption:= '键盘有动作';
end;
end.