Низкоуровневые процедуры обработки звука

Ниже приведен код, обрабатывающий аудиосигнал, получаемый со входа звуковой карты (SoundBlaster). Надеюсь он поможет разобраться вам с этой сложной темой.

Включенный в код модуль RECUNIT делает всю изнурительную работу по извлечению звука со входа звуковой карты.

var

  WaveRecorder: TWaveRecorder;

...

WaveRecorder := TwaveRecorder(2048, 4); // 4 размером 2048 байт

{ Устанавливает параметры дискретизации }
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
 477576218068 StartRecord: Boolean;
    Function477576218068 SetupRecord(P: PWaveRecorder): Boolean;

  end
;

  {*************************************************************************}

implementation


{-------------TWaveInGetErrorText-----------John Mertus---14-Июнь--97--}

function
 TWaveInGetErrorText(iErr: Integer): string
;

{ Выдает сообщения об ошибках WaveIn в формате Pascal                  }
{ iErr - номер ошибки                                                  }
{                                                                      }
{**********************************************************************}
var


  PlayInErrorMsgC: array
[0..255] of
 Char;

begin


  waveInGetErrorText(iErr, PlayInErrorMsgC, 255);
  TWaveInGetErrorText := StrPas(PlayInErrorMsgC);
end
;

{-------------InitWaveHeaders---------------John Mertus---14-Июнь--97--}

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
;

{-------------InitWaveHeaders---------------John Mertus---14-Июнь--97--}

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
;

{-------------AllocWaveHeader----------------John Mertus---14-Июнь--97--}

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
;

{---------------FreeWaveHeader---------------John Mertus---14-Июнь--97--}

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
;

{-------------AllocPCMBuffers----------------John Mertus---14-Июнь--97--}

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
;

{--------------FreePCMBuffers----------------John Mertus---14-Июнь--97--}

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
;

{--------------FreeWaveFormatEx--------------John Mertus---14-Июнь--97--}

procedure
 TWaveRecorder.FreeWaveFormatEx;

{ Просто освобождаем заголовки ExFormat headers                         }
{                                                                       }
{***********************************************************************}
begin


  if
 (pWaveFmtEx = nil
) then

    Exit;
  GlobalUnlock(hWaveFmtEx);
  GlobalFree(hWaveFmtEx);
  pWaveFmtEx := nil
;
end
;

{-------------TWaveRecorder.Create------------John Mertus-----Авг--97--}

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
;

{---------------------Destroy----------------John Mertus---14-Июнь--97--}

destructor
 TWaveRecorder.Destroy;

{ Просто освобождаем всю память, распределенную InitWaveRecorder.       }
{                                                                       }
{***********************************************************************}

begin


  FreeWaveFormatEx;
  FreePCMBuffers;
  FreeWaveHeader;
  inherited
 Destroy;
end
;

{------------CloseWaveDeviceRecord-----------John Mertus---14-Июнь--97--}

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
;

{------------------StopRecord-----------------John Mertus---14-Июнь--97--}

procedure
 TWaveRecorder.StopRecord;

{ Останавливаем запись и устанавливаем некоторые флаги.                 }
{                                                                       }
{***********************************************************************}
var


  iErr: Integer;

begin


  RecordActive := False
;
  iErr := waveInReset(WaveIn);
  { прекращаем запись и возвращаем стоящие в очереди буферы }
  if
 (iErr <> 0) then

  begin

    RecErrorMessage := 'Ошибка в waveInReset';
  end
;

  CloseWaveDeviceRecord;
end
;

{--------------AddNextBuffer------------------John Mertus---14-Июнь--97--}

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
;

{--------------BufferDoneCallBack------------John Mertus---14-Июнь--97--}

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
;

{------------------StartRecord---------------John Mertus---14-Июнь--97--}

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
;

{-----------------SetupRecord---------------John Mertus---14-Июнь--97--}

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
;

{-----------------ProcessBuffer---------------John Mertus---14-Июнь--97--}

procedure
 TWaveRecorder.ProcessBuffer(uMsg: Word; P: Pointer; n:
  Integer);

{ Болванка процедуры, вызываемой при готовности буфера.                 }
{                                                                       }
{***********************************************************************}
begin

end
;

end
.

Другое по теме:

• Как воспроизвести wav-файл из ресурса (в EXE)
• Работа с микрофоном
• Изменение громкости