Снятие звука с микрофона, отображение звуковые данных в виде графика

Previous  Top  Next

    
 

 

Code:

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Forms,

Dialogs, MMSystem;

 

type

TWavArrayBuf = array[0..1023]of byte;

PWavArrayBuf = ^TWavArrayBuf;

 

TForm1 = class(TForm)

   procedure FormCreate(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

   WaveFormat: TWaveFormatEx;

   WaveIn: PHWaveIn;

   procedure WndProc(var Msg: TMessage); override;

   function InitWaveIn: Boolean;

   procedure CloseWaveIn;

end;

 

var

Form1: TForm1;

 

implementation

 

uses Math;

 

{$R *.dfm}

 

function TForm1.InitWaveIn: Boolean;

var

I, Err: Integer;

WaveHdr: PWaveHdr;

WavBuff: PWavArrayBuf;

 

procedure FreeData;

begin

   if WavBuff <> nil then Dispose(WavBuff);

   if WaveHdr <> nil then Dispose(WaveHdr);

   if WaveIn <> nil then Dispose(WaveIn);

end;

 

begin

Result := False;

WaveFormat.wFormatTag := WAVE_FORMAT_PCM;

WaveFormat.nChannels := 1;

WaveFormat.nSamplesPerSec := 44100;

WaveFormat.nAvgBytesPerSec := 44100;

WaveFormat.nBlockAlign := 4;

WaveFormat.wBitsPerSample := 8;

WaveIn := New(PHWaveIn);

Err := WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW);

if Err <> 0 then Exit;

for i:=1 to 8 do

begin

   WavBuff := New(PWavArrayBuf);

   WaveHdr := New(PWaveHdr);

   with WaveHdr^ do

   begin

     lpData := Pointer(WavBuff);

     dwBufferLength := SizeOf(WavBuff);

     dwBytesRecorded := 0;

     dwUser := 0;

     dwFlags := 0;

     dwLoops := 0;

   end;

   Err := WaveInPrepareHeader(WaveIn^, WaveHdr, SizeOf(TWaveHdr));

   if Err <> 0 then

   begin

     FreeData;

     Exit;

   end;

   Err := WaveInAddBuffer(WaveIn^, WaveHdr, Sizeof(TWaveHdr));

   if Err <> 0 then

   begin

     FreeData;

     Exit;

   end;

end;

Err := WaveInStart(WaveIn^);

if Err <> 0 then

begin

   FreeData;

   Exit;

end;

Result := True;

end;

 

Procedure Tform1.WndProc(var Msg: TMessage);

var

Hdr: PWaveHdr;

I: Integer;

R: Real;

begin

inherited;

case Msg.Msg of

   MM_WIM_DATA:

   begin

     Hdr := PWaveHdr(Msg.LParam);

     if Hdr^.dwBytesRecorded = 0 then Exit;

     R := IfThen(Hdr^.dwBytesRecorded > 0,

       ClientWidth / Hdr^.dwBytesRecorded, 0);

     PatBlt(Canvas.Handle, 0, 0, ClientWidth,  ClientHeight, PATCOPY);

     Canvas.Pen.Color:=clRed;

     Canvas.MoveTo(0, 127);

     Canvas.LineTo(ClientWidth, 127);

     Canvas.Pen.Color := clMaroon;

     for I := 1 to 12 do

     begin

       Canvas.MoveTo(Round(R * (I * 100)), 0);

       Canvas.LineTo(Round(R * (I * 100)), 255);

     end;

     Canvas.Pen.Color:=clLime;

     Canvas.MoveTo(0, PWavArrayBuf(Hdr.lpData)^[0]);

     for I := 0 to Hdr^.dwBytesRecorded - 1 do

       Canvas.LineTo(Round(R * I), PWavArrayBuf(Hdr.lpData)^[I]);

 

     WaveInUnprepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));

     Dispose(hdr.lpData);

     DisPose(hdr);

 

     Hdr := New(PWaveHdr);

     Hdr^.lpData := Pointer(New(PWavArrayBuf));

     Hdr^.dwBufferLength := 1024;

     Hdr^.dwBytesRecorded := 0;

     Hdr^.dwUser := 0;

     Hdr^.dwFlags := 0;

     Hdr^.dwLoops := 0;

 

     WaveInPrepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));

     WaveInAddBuffer(WaveIn^, Hdr, Sizeof(TWaveHdr));

   end;

end;

end;

 

procedure TForm1.CloseWaveIn;

begin

WaveInStop(WaveIn^);

if WaveIn <> nil then

begin

   WaveInReset(WaveIn^);

   WaveInClose(WaveIn^);

end;

Dispose(WaveIn);

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

DoubleBuffered := True;

Height := 282;

Width := 1000;

Color := clBlack;

if not InitWaveIn then ShowMessage(SysErrorMessage(GetLastError));

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

CloseWaveIn;

end;

 

end.

 

 
 
Автор: Rouse_

Взято из http://forum.sources.ru

©Drkb::03619