Vumetro

Un vúmetro es un dispositivo que muestra la intensidad de una señal en unidades de volumen, y es muy habitual encontrarlo en equipos de sonido (mezcladores, amplificadores, etc..)

Este programa visualiza la forma de onda del sonido que pasa por el micrófono del PC y añade además un vúmetro de 2 canales.

Sólo tienen que conectar el micrófono al PC y empezar a hablar para probarlo.


Descargar programa
Descargar codigo fuente



Web:

http:\\www.cppblog.com\kenlistian 





UNIT3.PAS



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.