Delphi Magic: sonido

Mostrando entradas con la etiqueta sonido. Mostrar todas las entradas

Leer cabeceras de archivos de mp3 con Delphi

Aquí os dejo un componente (TAudioInfo) que extrae información de las cabeceras de archivos mp3 (MPEG 1, 2 Layers I, II, III) y de archivos con tags ID3V1.1.

También puede leer el formato Xing VBR (bitrate variable)

Freeware con código fuente Delphi incluido

Link:

http://regexpstudio.com/Downloads/audioinf.zip

Formato de cabeceras MP3:

http://www.mpgedit.org/mpgedit/mpeg_format/mpeghdr.htm#MPEG%20HEADER

Autor:

Andrey V. Sorokin, Saint Petersburg, Russia anso@mail.ru

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.

Osciloscopio con la tarjeta de sonido

Podemos utilizar la tarjeta de sonido como si fuese la sonda de entrada de un osciloscopio, con ello limitaremos el rango y la amplitud de frecuencias que podemos ver pero como material educativo y de experimentación es mas que suficiente.

Tiene un botón llamado "Spectrum" que analiza la amplitud de cada una de las frecuencias contenidas en una muestra. Se utiliza la transformada rápida de Fourier para analizar la señal.

Descargar programa

http://delphiforfun.org/programs/oscilloscope.htm

Reproducir archivos midi

Programa muy interesante que utiliza el componente tmidigen(no es necesario instalarlo previamente) para reproducir dinámicamente archivos midi.

Código fuente

Leer las pistas de un CD de audio

Los ficheros ".cda" describen las pistas contenidas en un CD audio. Estos ficheros están visibles en el explorador de Windows cuando abres una ventana correspondiente a un CD.

No existe una función del API que permita consultar el contenido de estos ficheros pero podéis utilizar las procedimientos contenidos en el siguiente fichero:

Autor: Pierre Castelain

Link de descarga