Visualizar el espectro de frecuencias del sonido

Visualiza el espectro de frecuencias de audio en diferentes formatos al reproducir archivos del tipo mp3 o wav utilizando la biblioteca de funciones de audio Bass.

Lo que nos dice el gráfico es que si en un audio predominan los agudos entonces la parte izquierda del gráfico aumentará de valor y al contrario si predominan las frecuencias bajas entonces las barras de la derecha subirán de valor.

Para que les sirva de referencia:


El registro grave de una voz masculina – 200Hz


El registro grave de una voz femenina – 350Hz


Rango medio–grave – 400Hz - 1 kHz (frecuencias cálidas)


Rango medio-agudo (“aspereza”, sonido “caliente”) – 2.5 kHz – 4 kHz.


Sibilancia (sonido “sss”, “siseo” de los platillos) – 8kHz – 15kHz. 




Autor: Ian Luck.


adaptado a Delphi por Evgeny Melnikov 



Descargar el programa  (el archivo bass.dll está en el Codigo fuente)


Codigo fuente

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.