Вопрос # 186: …ак сделать программную непрерывную задержку звука на 1-2сек. (например… (Мультимедийные приложения)

Здравствуте, подскажите как сделать программную непрерывную задержку звука на 1-2сек. (например вход микрофон, выход колонки)
Спасибо.

Здравствуйте, Ed13!

Данная тема достаточно сложная. Вот исходник для работы со звуком на низком уровне. Попробуйте разобраться. Удачи!!!

Приложение:

Ниже приведен код, обрабатывающий аудиосигнал, получаемый со входа звуковой карты (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.

Мини-форум вопроса

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 186

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 186

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом