Delphi 录音问题,紧急!!!

黑漆漆 2011-07-09 11:06:45
大家好,我正在编写一个Delphi程序,程序中要提供录音功能。

有没有哪位前辈能够提供一些关于录音的参考代码?

另外,最好是还能自动检测一下声音的大小,并返回给一个TProgessBar或是返回一个频谱,并且如果声音太小则进行提示。

有哪位高手能够办到么?教教我吧~!在线等啊!
...全文
697 20 打赏 收藏 转发到动态 举报
写回复
用AI写文章
20 条回复
切换为时间正序
请发表友善的回复…
发表回复
noliver 2013-12-03
  • 打赏
  • 举报
回复
这个wave的怎么存录音呢?好像没有存,光画波形
黑漆漆 2011-07-15
  • 打赏
  • 举报
回复
[Quote=引用 18 楼 sandyzhao 的回复:]
这个WaveFormat格式好像WAVE_FORMAT_PCM格式,PCM格式可能有限制,不能乱调整,你可以尝试调整,看程序会不会报错。
至于那段画波形代码,只是根据数据画点画线而已,没必要深入吧。
[/Quote]

因为我觉得它更新得太快了,想要减慢它的速度,但是有没有学过这方面的代码。

我指的减慢,不是减少取样次数,而是在取样次数不变的情况下,改变绘图的宽度。
sandyzhao 2011-07-14
  • 打赏
  • 举报
回复
这个WaveFormat格式好像WAVE_FORMAT_PCM格式,PCM格式可能有限制,不能乱调整,你可以尝试调整,看程序会不会报错。
至于那段画波形代码,只是根据数据画点画线而已,没必要深入吧。
黑漆漆 2011-07-13
  • 打赏
  • 举报
回复
哈哈~14楼看来是个高手了!

我想请教一下,上面那段代码,在以下6种情况该如何更改:

1、录制 16位——单声道——11025HZ;
2、录制 16位——单声道——22050HZ;
3、录制 16位——单声道——44100HZ;
4、录制 16位——双声道——11025HZ;
5、录制 16位——双声道——22050HZ;
6、录制 16位——双声道——44100HZ。

另外,下面这一小段代码是什么意思?求解释。
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]);
黑漆漆 2011-07-13
  • 打赏
  • 举报
回复
[Quote=引用 16 楼 sandyzhao 的回复:]
你的那段代码,
WaveFormat.nChannels := 1; //单声道
WaveFormat.nSamplesPerSec := 8000; //采样为8khz
WaveFormat.nAvgBytesPerSec := 8000;
WaveFormat.nBlockAlign := 1;
WaveFormat.wBitsPerSample := 8; //……
[/Quote]

汗~这个我是大概知道的……只是想具体问一下画波形的那段主要代码,各个参数是什么意思。
还有那几个“WaveFormat.……”在6种不同情况下该如何设置,因为我自己修改总是提示出错。
sandyzhao 2011-07-13
  • 打赏
  • 举报
回复
你的那段代码,
WaveFormat.nChannels := 1; //单声道
WaveFormat.nSamplesPerSec := 8000; //采样为8khz
WaveFormat.nAvgBytesPerSec := 8000;
WaveFormat.nBlockAlign := 1;
WaveFormat.wBitsPerSample := 8; //8位
至于那段代码就是画波形。
zhaodog 2011-07-12
  • 打赏
  • 举报
回复
你想监控声音大小就不要用控件,只能自己用wave这系列函数或directsound 来编程才可边录边取声音数据, 要调节声音的小可以用mixer相关的函数。
检测声音大小要根据你的录音编码是多少位,根据录音数据查看每位的数值,就可知道声音大小了
12楼就是用wave 函数来录音的


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;
//多缓冲录音,不用这么多,2个就可以了/color]
//创建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;


[color=#FF0000]//声音的回调 ,当录音的缓冲满了会调用


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;


grace_zou 2011-07-12
  • 打赏
  • 举报
回复
学习...
黑漆漆 2011-07-12
  • 打赏
  • 举报
回复
以下是我找到的一段可以成功绘制波形图的代码。但是麦克风音量仍然是个问题。另外,有谁能解读一下下面这段代码吗? 解读者有分!!! 然后,有哪位高手能够把下面这段代码的波形图改成柱形图吗?

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.
黑漆漆 2011-07-10
  • 打赏
  • 举报
回复
[Quote=引用 5 楼 chenjiaye000 的回复:]
我发现现在有个很棘手的问题,就是录制出来的声音很小啊!该怎么放大呢?
[/Quote]

问题更新:声音小主要是麦克风音量问题,急需调节麦克风音量的函数。
svcce 2011-07-10
  • 打赏
  • 举报
回复
[Quote=引用 3 楼 onlyou13 的回复:]
来自万一博客, 使用 TMediaPlayer 录制 wav 文件

http://www.cnblogs.com/del/archive/2009/11/10/1599835.html
[/Quote]

+1
不得闲 2011-07-10
  • 打赏
  • 举报
回复
网上找bass.dll,这个支持录音,播放!
山东蓝鸟贵薪 2011-07-10
  • 打赏
  • 举报
回复
等着吧,帮你顶顶......
黑漆漆 2011-07-10
  • 打赏
  • 举报
回复
顶起啊~高手快出现啊!
山东蓝鸟贵薪 2011-07-09
  • 打赏
  • 举报
回复
没试过这方面帮你顶一下........
「已注销」 2011-07-09
  • 打赏
  • 举报
回复
MARK
黑漆漆 2011-07-09
  • 打赏
  • 举报
回复
我发现现在有个很棘手的问题,就是录制出来的声音很小啊!该怎么放大呢?
黑漆漆 2011-07-09
  • 打赏
  • 举报
回复
[Quote=引用 3 楼 onlyou13 的回复:]
来自万一博客, 使用 TMediaPlayer 录制 wav 文件

http://www.cnblogs.com/del/archive/2009/11/10/1599835.html
[/Quote]

我去看了一下,里面不少东西让我受益匪浅,但是里面提供的代码运行总是出错,没有我之前的那些实用呃~

另外,我见过有的人写的录音程序,如果没有声音输入大概只有200KB,而我上面写出的代码,无论是否有声音输入文件都会很大,为什么呢?
onlyou13 2011-07-09
  • 打赏
  • 举报
回复
来自万一博客, 使用 TMediaPlayer 录制 wav 文件

http://www.cnblogs.com/del/archive/2009/11/10/1599835.html
黑漆漆 2011-07-09
  • 打赏
  • 举报
回复
录音代码我找到了,自己做了一些修改,并且已在Delphi7下测试通过,现在的问题就是如何自动检测一下声音的大小,并返回给一个TProgessBar或是返回一个频谱,并且如果声音太小则进行提示。

运行Delphi,在System页拖一个Mediaplayer控件到窗体上,默认名为Mediaplayer1。由于我们的程序是采用自己的按钮,所以将Mediaplayer1的Visible属性设置为False,其它属性保持默认值。再放两个按钮Button1和Button2。Button1的属性Name改为BtStart,Caption改为 "开始录音 ", Button2的属性Name改为BtStop,Caption改为 "停止录音 ",Enabled属性改为False。然后切换窗口到代码窗口,开始书写代码。


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.

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi GAME,图形处理/多媒体
社区管理员
  • GAME,图形处理/多媒体社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧