Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

6th
Мар

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

Posted by obzor under Delphi

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

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

Размер заранее не известен, но не более пяти минут.

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.

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

Код:


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.