Считывание звука с микрофона и воспроизведение его

[marina15056]

Я понимаю, что есть много уже готовых компонентов для записи звука и воспроизведении его, и сама раньше часто этим пользовалась, но в этот раз хочется всё сделать иначе.

Уже целую неделю топчусь на месте, перечитала кучу статей, примеров, что-то понятно, что-то нет, но ближе к делу:

что мне понятно

WFX: TWaveFormatEx;
BufLen: word;
buf: pointer;
hBuf: THandle;
WaveHdr: TWaveHdr;
bufsize: integer;
WaveIn: hWaveIn;
WaveOut: hWaveOut;

...
  with WFX do begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;  { количество каналов}
    nSamplesPerSec := 44100; { частота }
    wBitsPerSample := 16;
    nBlockAlign := nChannels * (wBitsPerSample div 8);
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize := 0;
  end;

  BufSize := 5000; { Размер буфера }

  BufLen := WFX.nBlockAlign* BufSize;
  hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
  Buf := GlobalLock(hBuf);
  with WaveHdr do begin
    lpData := Buf;
    dwBufferLength := BufLen;
    dwFlags := WHDR_BEGINLOOP;
  end;

  WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(WFX), Form1.Handle, 0, CALLBACK_WINDOW);
  WaveInPrepareHeader(WaveIn, Addr(WaveHdr), sizeof(WaveHdr));
  WaveInAddBuffer(WaveIn, addr(WaveHdr), sizeof(WaveHdr));
  WaveInStart(WaveIn);
//здесь начинается запись звука в буфер
  WaveInReset(WaveIn);
  WaveInClose(WaveIn);
//а здесь заканчивается

  WaveOutOpen(Addr(WaveOut), WAVE_MAPPER, addr(WFX), Form1.Handle, 0, CALLBACK_WINDOW);
  waveOutPrepareHeader(WaveOut, Addr(WaveHdr), sizeof(WaveHdr));
  waveOutWrite(WaveOut, addr(WaveHdr), sizeof(WaveHdr));
//это проигрывается записанный в буфер звук

Не понятно, как записать большой отрезок, ведь буфер не рекомендуют делать большим. Очевидно, что записанное нужно как-то и куда-то сохранять, а потом как-то это нужно проиграть. Объясните что да как. Буду очень благодарна.

ЗЫ: и да, размер заранее не известен, но не более пяти минут

[volod3000]

http://programmersforum.ru/showthread.php?t=91506

http://www.delphisources.ru/pages/fa...ite_sound.html

[Aliens_wolfs]

Это программа работает с микрофоном и сразу воспроизводит звук написана с помощью Bass. Может что то для себя и найдете в ней.
http://zalil.ru/31372792

[marina15056]

Наверно со мной что-то не так, как говорится "смотрю в книгу, вижу фигу".
Нельзя ли вместо ссылок на этот раз помочь мне советом.

Допустим в WaveHdr уже записан звук. Я его хочу сохранить в MemoryStream. И делаю так:

type
  TWaveHeader = record
    idRiff: array [0..3] of ansichar;
    RiffLen: longint;
    idWave: array [0..3] of ansichar;
    idFmt: array [0..3] of ansichar;
    InfoLen: longint;
    WaveType: smallint;
    Ch: smallint;
    Freq: longint; 
    BytesPerSec: longint;             
    align: smallint; 
    Bits: smallint;
  end;
type
  TDataHeader = record
    idData: array [0..3] of ansichar;
    DataLen: longint;
  end;

  M: TMemoryStream;
...

 sec:= 1;
 SampleCount:=WFX.nSamplesPerSec*sec;
 BytesPerSample := WFX.wBitsPerSample div 8;
 len:=SampleCount * BytesPerSample * WFX.nChannels;

 M := nil;
 M := TMemoryStream.Create;
   with WaveHeader do begin
    idRiff := 'RIFF';
    RiffLen := len + 38;
    idWave := 'WAVE';
    idFmt := 'fmt ';
    InfoLen := 16;
    WaveType := WFX.wFormatTag;
    Ch := WFX.nChannels;
    Freq := WFX.nSamplesPerSec;
    BytesPerSec := WFX.nAvgBytesPerSec;
    align := WFX.nBlockAlign;
    Bits := WFX.wBitsPerSample;
  end;
 m.Write(WaveHeader, sizeof(TWaveHeader));
   with DataHeader do begin
    idData := 'data';
    DataLen := len;
  end;
 m.Write(DataHeader, sizeof(TDataHeader));

Заголовок wav файла готов, а дальше как писать???
m.Write(??????????????);

[marina15056]

Спасибо за красноречивое молчание. С его помощью я поняла что такое WAV, потоки, даже буфер и почти ссылки...
Оставляю работающий пример для тех, у кого-то будут подобные проблемы с записью и воспроизведением звука.

[Zis67]

Тема старая но ищущим думаю пригодится.

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, mmsystem, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure OnWaveMessage(var msg:TMessage); message MM_WIM_DATA;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

tj=class(tthread)
procedure execute; override;
end;

var
  Form1: TForm1;
  neformat:tWAVEFORMATex;
  begining:twavehdr;
  outer:array [0..3] of twavehdr;
  Sin:hwavein;
  Sout:hwaveout;
  buf,bufffer:array[0..(44100 div 10)-1] of smallint; //4409
  cycle,rrrrr:byte;
  lisnstream:tmemorystream;
  just:tj;
implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
waveInClose(Sin);
waveOutClose(Sout);
end;

procedure tj.execute;
begin
for cycle:=0 to 3 do begin
waveOutPrepareHeader(Sout,@outer[cycle],sizeof(outer));
waveOutWrite(Sout,@outer[cycle],sizeof(outer));
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
just:=tj.create(true);
just.Priority:=tpnormal;

neformat.nChannels:=1; //моно
neformat.wFormatTag:=WAVE_FORMAT_pcm; //формат Waveform audio (в данном случае импульсно-кодовая модуляция (передача непрерывных функций в виде двоичного кода))
neformat.nSamplesPerSec:=25000; //частота дискретизации (количество выборок в секунду)
neformat.wBitsPerSample:=8;
neformat.nBlockAlign:=1;
neformat.nAvgBytesPerSec:=25000;
neformat.cbSize:=0;
begining.lpData:=@bufffer;
begining.dwBufferLength:=sizeof(bufffer);
lisnstream:=tmemorystream.Create;
for rrrrr:=0 to 3 do begin
outer[rrrrr].dwBufferLength:=sizeof(bufffer);
end;
waveInOpen(@Sin,WAVE_MAPPER,addr(neformat),self.Handle,0,CALLBACK_WINDOW);
waveOutOpen(@Sout,WAVE_MAPPER,@neformat,self.Handle,0,CALLBACK_WINDOW);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=vk_control then begin
waveInPrepareHeader(Sin,@begining,sizeof(Twavehdr));
waveInAddBuffer(Sin,@begining,sizeof(TwaveHdr));
waveInStart(Sin);
end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=vk_control then begin
waveInUnprepareHeader(Sin,@begining,sizeof(TwaveHdr));
waveInReset(Sin); //stop
waveOutReset(Sout);
just.Terminate;
end;
end;


procedure TForm1.OnWaveMessage(var msg: TMessage);
begin
waveInPrepareHeader(Sin,@begining,sizeof(Twavehdr));
waveInAddBuffer(Sin,@begining,sizeof(TwaveHdr));
if rrrrr>3 then rrrrr:=0;
if rrrrr=3 then just.Execute;
outer[rrrrr].lpData:=begining.lpData;
inc(rrrrr);
end;

end.

[Aliens_wolfs]

Минимальный код на Bass, считывание с микрофона звук и сразу его воспроизведение.
Простенький пример может кому пригодиться.
При желании можно запись в файл, ловить буфер в RecordingCallback и объявить заголовок затем записывать через tmemorystream затем сохранять в файл, а можно и сразу в файл.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Bass, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  chanPl, ChanMic: Dword;

implementation

{$R *.dfm}

function RecordingCallback(Handle: HRECORD; buffer: Pointer; size, user: DWord):
 boolean; stdcall;
begin
 BASS_StreamPutData(chanPl, Buffer, size);
  BASS_ChannelPlay(chanPl, false);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 if (not BASS_Init(-1, 44100, 0, Handle, nil)) then
	begin
		BASS_Free();
		MessageDlg('Cannot start default device!', mtError, [mbOk], 0);
	end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
BASS_RecordInit(-1);
chanMic:=BASS_RecordStart(8000, 2, BASS_DEVICE_8BITS, @RecordingCallback, nil);
chanPl:= BASS_StreamCreate(8000, 2, BASS_DEVICE_8BITS, STREAMPROC_PUSH, nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BASS_RecordFree;
BASS_StreamFree(chanPL);
BASS_StreamFree(chanMic);
BASS_Free();
end;

end.

[torturer]

Сообщение от Aliens_wolfs

Минимальный код на Bass, считывание с микрофона звук и сразу его воспроизведение.
Простенький пример может кому пригодиться.
При желании можно запись в файл, ловить буфер в RecordingCallback и объявить заголовок затем записывать через tmemorystream затем сохранять в файл, а можно и сразу в файл.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Bass, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  chanPl, ChanMic: Dword;

implementation

{$R *.dfm}

function RecordingCallback(Handle: HRECORD; buffer: Pointer; size, user: DWord):
 boolean; stdcall;
begin
 BASS_StreamPutData(chanPl, Buffer, size);
  BASS_ChannelPlay(chanPl, false);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 if (not BASS_Init(-1, 44100, 0, Handle, nil)) then
	begin
		BASS_Free();
		MessageDlg('Cannot start default device!', mtError, [mbOk], 0);
	end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
BASS_RecordInit(-1);
chanMic:=BASS_RecordStart(8000, 2, BASS_DEVICE_8BITS, @RecordingCallback, nil);
chanPl:= BASS_StreamCreate(8000, 2, BASS_DEVICE_8BITS, STREAMPROC_PUSH, nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BASS_RecordFree;
BASS_StreamFree(chanPL);
BASS_StreamFree(chanMic);
BASS_Free();
end;

end.

a kak mojno zdelat zapis po vremeny? toest posle naprimer pol 4esa zapis ostonovilas saxranilas i pradaljila zapis.

[Aliens_wolfs]

Сразу записываем звук в файл.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Bass, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  chanPlay, ChanMic: Dword;

implementation

{$R *.dfm}

//Функция для записи звука в файл
procedure SaveWav(hChan: HRECORD; FileName: string; Buffer: pointer; Size: Integer);
  type
    PWaveHeader = ^TWaveHeader;
    TWaveHeader = record
    idRiff        : array [0..3] of Char;
    RiffLen       : LongInt;
    idWave        : Array[0..3] of Char;
    idFmt         : Array[0..3] of Char;
    InfoLen       : LongInt;
    FormatTag     : Word;
    Channels      : Word;
    Freq          : LongInt;
    BytesPerSec   : LongInt;
    BlockAlign    : Word;
    BitsPerSample : Word;
    idData        : Array[0..3] of Char;
    DataBytes     : LongInt;
  end;
var
  header: TWaveHeader;
  BASS_INFO: BASS_CHANNELINFO ;
  f : File;
  iSeek: Integer;
begin

if (Buffer <> nil)and(Size > 0) then
begin
   FillChar(BASS_INFO, SizeOf(BASS_INFO), 0);
   FillChar(header, SizeOf(TWaveHeader), 0);

//Узнаем информацию о канале
  BASS_ChannelGetInfo(hChan, BASS_INFO);

    {$I-}
   AssignFile(f, FileName);
   FileMode := fmOpenReadWrite;
   Reset(f, 1);
   {$I+}
   if IOResult > 0 then
   rewrite(F, 1)
   else
   begin
   seek(f, 0);
   BlockRead(f, header, SizeOf(TWaveHeader));
   end;

//выше читаем заголовок для перезаписи и вычисляем размер
   with header do
  begin
    idRiff        :='RIFF';
    RiffLen       := SizeOf(TWaveHeader);
    idWave        :='WAVE';
    idFmt         :='fmt ';
    InfoLen       := 16;
    FormatTag     := 1;
    Channels      :=BASS_INFO.chans;
    Freq          :=BASS_INFO.freq;
    BitsPerSample := 8;
    BlockAlign    := Channels * (BitsPerSample div 8);
    BytesPerSec   := Freq * BlockAlign;
    idData        :='data';
    DataBytes     := DataBytes + Size;
  end;

//Запись заголовка
 seek(f, 0);
 BlockWrite(f, header, SizeOf(TWaveHeader));
//Запись данных в конец файла
 iSeek:= filesize(f);
 seek(f, iSeek);
 BlockWrite(f, Buffer^, Size);
 CloseFile(f);
 end;
 end;


function RecordingCallback(hChan: HRECORD; buffer: Pointer; Size, user: DWord):
 boolean; stdcall;
 var
 pPos, Postime: integer;
begin
//Выводим время это так для примера
  pPos:= BASS_ChannelGetPosition(hChan, 0);
     if (pPos > 0) then
  begin
    Postime := Trunc(BASS_ChannelBytes2Seconds(hChan, pPos));
    Form1.Caption := (Format(' %d:%.2d', [Postime div 60, Postime mod 60]));
  end;

//запись в файл
  SaveWav(hChan, 'D:\1111.wav', buffer, Size);

//Воспроизводим звук с микрофона
 BASS_StreamPutData(chanPlay, Buffer, Size);
 BASS_ChannelPlay(chanPlay, false);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 if (not BASS_Init(-1, 44100, 0, Handle, nil)) then
	begin
	BASS_Free();
	MessageDlg('Cannot start default device!', mtError, [mbOk], 0);
   end;
end;

//Запускаем
procedure TForm1.Button1Click(Sender: TObject);
begin
BASS_RecordInit(-1);
chanMic:=BASS_RecordStart(8000, 2, BASS_DEVICE_8BITS, @RecordingCallback, nil);
chanPlay:= BASS_StreamCreate(8000, 2, BASS_DEVICE_8BITS, STREAMPROC_PUSH, nil);
end;

//Останавливаем
procedure TForm1.Button2Click(Sender: TObject);
begin
BASS_RecordFree;
BASS_StreamFree(chanPlay);
BASS_StreamFree(chanMic);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Button2Click(nil);
bass_free;
end;

end.

[torturer]

Aliens_wolfs программа выдает ошибку:

raised exception class ElnOutError with message 'I/O error 21'. Process stopped.