Delphi 录音问题，紧急！！！

Question

录音代码我找到了，自己做了一些修改，并且已在Delphi7下测试通过，现在的问题就是如何自动检测一下声音的大小，并返回给一个TProgessBar或是返回一个频谱，并且如果声音太小则进行提示。运行Delphi,在System页拖一个Mediaplayer控件到窗体上,默认名为Mediaplayer1。由于我们的程序是采用自己的按钮,所以将Mediaplayer1的Visible属性设置为False,其它属性保持默认值。再放两个按钮Button1和Button2。Button1的属性Name改为BtStart,Caption改为 "开始录音 ",   Button2的属性Name改为BtStop,Caption改为 "停止录音 ",Enabled属性改为False。然后切换窗口到代码窗口,开始书写代码。
unit Unit1;interfaceuses
  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.

Answer 1

来自万一博客， 使用 TMediaPlayer 录制 wav 文件http://www.cnblogs.com/del/archive/2009/11/10/1599835.html

Answer 2

网上找bass.dll,这个支持录音，播放！

Answer 3

以下是我找到的一段可以成功绘制波形图的代码。但是麦克风音量仍然是个问题。另外，有谁能解读一下下面这段代码吗？ 解读者有分！！！ 然后，有哪位高手能够把下面这段代码的波形图改成柱形图吗？unit Unit3;interfaceuses
  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.

Answer 4

你想监控声音大小就不要用控件，只能自己用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;

Answer 5

哈哈~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]);

Answer 6

你的那段代码，
  WaveFormat.nChannels := 1; //单声道
  WaveFormat.nSamplesPerSec := 8000; //采样为8khz
  WaveFormat.nAvgBytesPerSec := 8000;
  WaveFormat.nBlockAlign := 1;
  WaveFormat.wBitsPerSample := 8; //8位  
至于那段代码就是画波形。

Answer 7

汗~这个我是大概知道的……只是想具体问一下画波形的那段主要代码，各个参数是什么意思。
还有那几个“WaveFormat.……”在6种不同情况下该如何设置，因为我自己修改总是提示出错。

Answer 8

这个WaveFormat格式好像WAVE_FORMAT_PCM格式，PCM格式可能有限制，不能乱调整，你可以尝试调整，看程序会不会报错。
至于那段画波形代码，只是根据数据画点画线而已，没必要深入吧。

Answer 9

这个wave的怎么存录音呢？好像没有存，光画波形