Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: октябрь 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Запись звука


Автор: John Mertus


 var
   WaveRecorder : TWaveRecorder;
   // 4 размером 2048 байт
   WaveRecorder := TwaveRecorder(2048, 4);
 
 { Устанавливает параметры дискретизации }
 with WaveRecorder.pWavefmtEx do
 begin
   wFormatTag := WAVE_FORMAT_PCM;
   nChannels := 1;
   nSamplesPerSec := 20000;
   wBitsPerSample := 16;
   nAvgBytesPerSec := nSamplesPerSec*(wBitsPerSample div 8)*nChannels;
 end;
 
 // Затем используем вариантную запись, поскольку я не знаю
 // как получить адрес самого объекта
 WaveRecorder.SetupRecord(@WaveRecorder);
 
 // Начинаем запись
 WaveRecorder.StartRecord;
 
 // При каждом заполнении буфера вызывается процедура
 WaveRecorder.Processbuffer.
 
 // Заканчиваем запись
 WaveRecorder.StopRecord;
 WaveRecorder.Destroy;
 
 {
 
 Имя файла: RECUNIT.PAS V 1.01
 Создан: Авг 19 1996 в 21:56 на IBM ThinkPad
 Ревизия #7: Авг 22 1997, 15:01 на IBM ThinkPad
 -John Mertus
 
 Данный модуль содержит необходимые процедуры для записи звука.
 
 Версия 1.00 - первый релиз
 1.01 - добавлен TWaveInGetErrorText
 }
 
 {-Unit-RECUNIT----------John Mertus---Авг 96---}
 
 unit RECUNIT;
 
 interface
 
 uses
   Windows, MMSystem, SysUtils, MSACM;
 
 { Ниже определен класс TWaveRecorder для обслуживания входа звуковой }
 { карты. Ожидается, что новый класс будет производным от TWaveRecorder }
 { и перекроет TWaveRecorder.ProcessBuffer. После начала записи данная }
 { процедура вызывается каждый раз при наличии в буфере аудио-данных. }
 
 const
   MAX_BUFFERS = 8;
 
 type
   PWaveRecorder = ^TWaveRecorder;
   TWaveRecorder = class(TObject)
     constructor Create(BfSize, TotalBuffers : Integer);
     destructor Destroy; override;
     procedure ProcessBuffer(uMsg : Word; P : Pointer; n : Integer); virtual;
   private
     fBufferSize : Integer; // Размер буфера
     BufIndex : Integer;
     fTotalBuffers : Integer;
 
     pWaveHeader : array [0..MAX_BUFFERS-1] of PWAVEHDR;
     hWaveHeader : array [0..MAX_BUFFERS-1] of THANDLE;
     hWaveBuffer : array [0..MAX_BUFFERS-1] of THANDLE;
     hWaveFmtEx : THANDLE;
     dwByteDataSize : DWORD;
     dwTotalWaveSize : DWORD;
 
     RecordActive : Boolean;
     bDeviceOpen : Boolean;
 
     { Внутренние функции класса }
     function InitWaveHeaders : Boolean;
     function AllocPCMBuffers : Boolean;
     procedure FreePCMBuffers;
 
     function AllocWaveFormatEx : Boolean;
     procedure FreeWaveFormatEx;
 
     function AllocWaveHeaders : Boolean;
     procedure FreeWaveHeader;
 
     function AddNextBuffer : Boolean;
     procedure CloseWaveDeviceRecord;
   public
     { Public declarations }
     pWaveFmtEx : PWaveFormatEx;
     WaveBufSize : Integer; { Размер поля nBlockAlign }
     InitWaveRecorder : Boolean;
     RecErrorMessage : string;
     QueuedBuffers,
     ProcessedBuffers : Integer;
     pWaveBuffer : array [0..MAX_BUFFERS-1] of lpstr;
     WaveIn : HWAVEIN; { Дескриптор Wav-устройства }
 
     procedure StopRecord;
     function 477576218068StartRecord : Boolean;
     function 477576218068SetupRecord(P : PWaveRecorder) : Boolean;
 end;
 
 implementation
 
 function TWaveInGetErrorText(iErr : Integer) : string;
 { Выдает сообщения об ошибках WaveIn в формате Pascal }
 { iErr - номер ошибки }
 var
   PlayInErrorMsgC : array [0..255] of Char;
 begin
   waveInGetErrorText(iErr,PlayInErrorMsgC,255);
   TWaveInGetErrorText := StrPas(PlayInErrorMsgC);
 end;
 
 function TWaveRecorder.AllocWaveFormatEx : Boolean;
 { Распределяем формат большого размера, требуемый для инсталляции ACM-в}
 var
   MaxFmtSize : UINT;
 begin
   { maxFmtSize - сумма sizeof(WAVEFORMATEX) + pwavefmtex.cbSize }
   if( acmMetrics( 0, ACM_METRIC_MAX_SIZE_FORMAT, maxFmtSize ) <> 0) >then
   begin
     RecErrorMessage := 'Ошибка получения размера формата максимального сжатия';
     AllocWaveFormatEx := False;
     Exit;
   end;
 
   { распределяем структуру WAVEFMTEX }
   hWaveFmtEx := GlobalAlloc(GMEM_MOVEABLE, maxFmtSize);
   if (hWaveFmtEx = 0) then
   begin
     RecErrorMessage := 'Ошибка распределения памяти для структуры WaveFormatEx';
     AllocWaveFormatEx := False;
     Exit;
   end;
 
   pWaveFmtEx := PWaveFormatEx(GlobalLock(hWaveFmtEx));
   if (pWaveFmtEx = nil) then
   begin
     RecErrorMessage := 'Ошибка блокировки памяти WaveFormatEx';
     AllocWaveFormatEx := False;
     Exit;
   end;
 
   { инициализация формата в стандарте PCM }
   ZeroMemory( pwavefmtex, maxFmtSize );
   pwavefmtex.wFormatTag := WAVE_FORMAT_PCM;
   pwavefmtex.nChannels := 1;
   pwavefmtex.nSamplesPerSec := 20000;
   pwavefmtex.nBlockAlign := 1;
   pwavefmtex.wBitsPerSample := 16;
   pwavefmtex.nAvgBytesPerSec := pwavefmtex.nSamplesPerSec*
   (pwavefmtex.wBitsPerSample div 8)*pwavefmtex.nChannels;
   pwavefmtex.cbSize := 0;
 
   { Все успешно, идем домой }
   AllocWaveFormatEx := True;
 end;
 
 function TWaveRecorder.InitWaveHeaders : Boolean;
 { Распределяем память, обнуляем заголовок wave и инициализируем }
 var
   i : Integer;
 begin
   { делаем размер буфера кратным величине блока... }
   WaveBufSize := fBufferSize - (fBufferSize mod pwavefmtex.nBlockAlign);
 
   { Устанавливаем wave-заголовки }
   for i := 0 to fTotalBuffers-1 do
     with pWaveHeader[i]^ do
     begin
       lpData := pWaveBuffer[i];      // адрес буфера waveform
       dwBufferLength := WaveBufSize; // размер, в байтах, буфера
       dwBytesRecorded := 0;          // смотри ниже
       dwUser := 0;                   // 32 бита данных пользователя
       dwFlags := 0;                  // смотри ниже
       dwLoops := 0;                  // смотри ниже
       lpNext := nil;                 // зарезервировано; должен быть ноль
       reserved := 0;                 // зарезервировано; должен быть ноль
     end;
 
   InitWaveHeaders := TRUE;
 end;
 
 function TWaveRecorder.AllocWaveHeaders : Boolean;
 { Распределяем и блокируем память заголовка }
 var
   i : Integer;
 begin
   for i := 0 to fTotalBuffers-1 do
   begin
     hwaveheader[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or
     GMEM_ZEROINIT, sizeof(TWAVEHDR));
 
     if (hwaveheader[i] = 0) then
     begin
       { Примечание: Это может привести к утечке памяти, надеюсь скоро исправить }
       RecErrorMessage := 'Ошибка распределения памяти для wave-заголовка';
       AllocWaveHeaders := FALSE;
       Exit;
     end;
 
     pwaveheader[i] := GlobalLock (hwaveheader[i]);
     if (pwaveheader[i] = nil ) then
     begin
       { Примечание: Это может привести к утечке памяти, надеюсь скоро исправить }
       RecErrorMessage := 'Не могу заблокировать память заголовка для записи';
       AllocWaveHeaders := FALSE;
       Exit;
     end;
   end;
   AllocWaveHeaders := TRUE;
 end;
 
 procedure TWaveRecorder.FreeWaveHeader;
 { Просто освобождаем распределенную AllocWaveHeaders память. }
 var
   i : Integer;
 begin
   for i := 0 to fTotalBuffers-1 do
   begin
     if (hWaveHeader[i] <> 0) then
     begin
       GlobalUnlock(hwaveheader[i]);
       GlobalFree(hwaveheader[i]);
       hWaveHeader[i] := 0;
     end
   end;
 end;
 
 function TWaveRecorder.AllocPCMBuffers : Boolean;
 { Распределяем и блокируем память waveform. }
 var
   i : Integer;
 begin
   for i := 0 to fTotalBuffers-1 do
   begin
     hWaveBuffer[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, fBufferSize );
     if (hWaveBuffer[i] = 0) then
     begin
       { Здесь возможна утечка памяти }
       RecErrorMessage := 'Ошибка распределения памяти wave-буфера';
       AllocPCMBuffers := False;
       Exit;
     end;
 
     pWaveBuffer[i] := GlobalLock(hWaveBuffer[i]);
     if (pWaveBuffer[i] = nil) then
     begin
       { Здесь возможна утечка памяти }
       RecErrorMessage := 'Ошибка блокирования памяти wave-буфера';
       AllocPCMBuffers := False;
       Exit;
     end;
     pWaveHeader[i].lpData := pWaveBuffer[i];
   end;
   AllocPCMBuffers := TRUE;
 end;
 
 procedure TWaveRecorder.FreePCMBuffers;
 { Освобождаем использованную AllocPCMBuffers память. }
 var
   i : Integer;
 begin
   for i := 0 to fTotalBuffers-1 do
   begin
     if (hWaveBuffer[i] <> 0) then
     begin
       GlobalUnlock( hWaveBuffer[i] );
       GlobalFree( hWaveBuffer[i] );
       hWaveBuffer[i] := 0;
       pWaveBuffer[i] := nil;
     end;
   end;
 end;
 
 procedure TWaveRecorder.FreeWaveFormatEx;
 { Просто освобождаем заголовки ExFormat headers }
 begin
   if (pWaveFmtEx = nil) then
     Exit;
   GlobalUnlock(hWaveFmtEx);
   GlobalFree(hWaveFmtEx);
   pWaveFmtEx := nil;
 end;
 
 constructor TWaveRecorder.Create(BFSize, TotalBuffers : Integer);
 { Устанавливаем wave-заголовки, инициализируем указатели данных и }
 { и распределяем буферы дискретизации }
 { BFSize - размер буфера в байтах }
 var
   i : Integer;
 begin
   inherited Create;
   for i := 0 to fTotalBuffers-1 do
   begin
     hWaveHeader[i] := 0;
     hWaveBuffer[i] := 0;
     pWaveBuffer[i] := nil;
     pWaveFmtEx := nil;
   end;
   fBufferSize := BFSize;
 
   fTotalBuffers := TotalBuffers;
   { распределяем память для структуры wave-формата }
   if(not AllocWaveFormatEx) then
   begin
     InitWaveRecorder := FALSE;
     Exit;
   end;
 
   { ищем устройство, совместимое с доступными wave-характеристиками }
   if (waveInGetNumDevs < 1 ) then
   begin
     RecErrorMessage := 'Не найдено устройств, способных записывать звук';
     InitWaveRecorder := FALSE;
     Exit;
   end;
 
   { распределяем память wave-заголовка }
   if (not AllocWaveHeaders) then
   begin
     InitWaveRecorder := FALSE;
     Exit;
   end;
 
   { распределяем память буфера wave-данных }
   if (not AllocPCMBuffers) then
   begin
     InitWaveRecorder := FALSE;
     Exit;
   end;
   InitWaveRecorder := TRUE;
 end;
 
 destructor TWaveRecorder.Destroy;
 { Просто освобождаем всю память, распределенную InitWaveRecorder. }
 begin
   FreeWaveFormatEx;
   FreePCMBuffers;
   FreeWaveHeader;
   inherited Destroy;
 end;
 
 procedure TWaveRecorder.CloseWaveDeviceRecord;
 { Просто освобождаем (закрываем) waveform-устройство. }
 var
   i : Integer;
 begin
   { если устройство уже закрыто, то выходим }
   if (not bDeviceOpen) then
     Exit;
 
   { работа с заголовками - unprepare }
   for i := 0 to fTotalBuffers-1 do
     if (waveInUnprepareHeader(WaveIn, pWaveHeader[i],
     sizeof(TWAVEHDR)) <> 0 ) then
       RecErrorMessage := 'Ошибка в waveInUnprepareHeader';
 
   { сохраняем общий объем записи и обновляем показ }
   dwTotalwavesize := dwBytedatasize;
 
   { закрываем входное wave-устройство }
   if (waveInClose(WaveIn) <> 0) then
     RecErrorMessage := 'Ошибка закрытия входного устройства';
 
   { сообщаем вызвавшей функции, что устройство закрыто }
   bDeviceOpen := FALSE;
 end;
 
 procedure TWaveRecorder.StopRecord;
 { Останавливаем запись и устанавливаем некоторые флаги. }
 var
   iErr : Integer;
 begin
   RecordActive := False;
   iErr := waveInReset(WaveIn);
   { прекращаем запись и возвращаем стоящие в очереди буферы }
   if (iErr <> 0) then
     RecErrorMessage := 'Ошибка в waveInReset';
   CloseWaveDeviceRecord;
 end;
 
 function TWaveRecorder.AddNextBuffer : Boolean;
 { Добавляем буфер ко входной очереди и переключаем буферный индекс. }
 var
   iErr : Integer;
 begin
   { ставим буфер в очередь для получения очередной порции данных }
   iErr := waveInAddBuffer(WaveIn, pwaveheader[bufindex], sizeof(TWAVEHDR));
   if (iErr <> 0) then
   begin
     StopRecord;
     RecErrorMessage := 'Ошибка добавления буфера' + TWaveInGetErrorText(iErr);
     AddNextBuffer := FALSE;
     Exit;
   end;
 
   { переключаемся на следующий буфер }
   bufindex := (bufindex+1) mod fTotalBuffers;
   QueuedBuffers := QueuedBuffers + 1;
 
   AddNextBuffer := TRUE;
 end;
 
 procedure BufferDoneCallBack(
 hW : HWAVE;         // дескриптор waveform-устройства
 uMsg : DWORD;       // посылаемое сообщение
 dwInstance : DWORD; // экземпляр данных
 dwParam1 : DWORD;   // определяемый приложением параметр
 dwParam2 : DWORD;   // определяемый приложением параметр
 ); stdcall;
 { Вызывается при наличии у wave-устройства какой-либо информации, }
 { например при заполнении буфера }
 var
   BaseRecorder : PWaveRecorder;
 begin
   BaseRecorder := Pointer(DwInstance);
   with BaseRecorder^ do
   begin
     ProcessBuffer(uMsg, pWaveBuffer[ProcessedBuffers mod fTotalBuffers],
     WaveBufSize);
 
     if (RecordActive) then
       case uMsg of
         WIM_DATA:
         begin
           BaseRecorder.AddNextBuffer;
           ProcessedBuffers := ProcessedBuffers+1;
         end;
       end;
   end;
 end;
 
 function TWaveRecorder.StartRecord : Boolean;
 { Начало записи. }
 var
   iErr, i : Integer;
 begin
   { начало записи в первый буфер }
   iErr := WaveInStart(WaveIn);
   if (iErr <> 0) then
   begin
     CloseWaveDeviceRecord;
     RecErrorMessage := 'Ошибка начала записи wave: ' +
     TWaveInGetErrorText(iErr);
   end;
 
   RecordActive := TRUE;
 
   { ставим в очередь следующие буферы }
   for i := 1 to fTotalBuffers-1 do
     if (not AddNextBuffer) then
     begin
       StartRecord := FALSE;
       Exit;
     end;
 
   StartRecord := True;
 end;
 
 function TWaveRecorder.SetupRecord(P : PWaveRecorder) : Boolean;
 { Данная функция делает всю работу по созданию waveform-"записывателя". }
 var
   iErr, i : Integer;
 begin
   dwTotalwavesize := 0;
   dwBytedatasize := 0;
   bufindex := 0;
   ProcessedBuffers := 0;
   QueuedBuffers := 0;
 
   { открываем устройство для записи }
   iErr := waveInOpen(@WaveIn, WAVE_MAPPER, pWaveFmtEx,
   Integer(@BufferDoneCallBack),
   Integer(P), CALLBACK_FUNCTION + WAVE_ALLOWSYNC );
 
   if (iErr <> 0) then
   begin
     RecErrorMessage := 'Не могу открыть входное устройство для записи: ' + ^M
     + TWaveInGetErrorText(iErr);
     SetupRecord := FALSE;
     Exit;
   end;
 
   { сообщаем CloseWaveDeviceRecord(), что устройство открыто }
   bDeviceOpen := TRUE;
 
   { подготавливаем заголовки }
   InitWaveHeaders();
 
   for i := 0 to fTotalBuffers-1 do
   begin
     iErr := waveInPrepareHeader( WaveIn, pWaveHeader[I], sizeof(TWAVEHDR));
     if (iErr <> 0) then
     begin
       CloseWaveDeviceRecord;
       RecErrorMessage := 'Ошибка подготовки заголовка для записи: ' + ^M +
       TWaveInGetErrorText(iErr);
       SetupRecord := FALSE;
       Exit;
     end;
   end;
 
   { добавляем первый буфер }
   if (not AddNextBuffer) then
   begin
     SetupRecord := FALSE;
     Exit;
   end;
 
   SetupRecord := TRUE;
 end;
 
 procedure TWaveRecorder.ProcessBuffer(uMsg: Word; P : Pointer;
 n: Integer);
 { Болванка процедуры, вызываемой при готовности буфера. }
 begin
 end;
 
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS