Форум: "Media";
Текущий архив: 2004.07.04;
Скачать: [xml.tar.bz2];

Вниз

Фильтр НЧ   Найти похожие ветки 

← →
Boson   (2004-04-22 06:23) [0]

Подскажите,плз,как бы скумекать фильтр низких частот,с изменением частоты среза?Пробовал накапливать сэмплы,но там щелчки при перемене глубины(этой частоты среза).Или я чой-то не пойму?

---

← →
Boson   (2004-04-22 07:00) [1]

Чуть не забыл,кому нужно -
Ввод - Вывод звука:

unit livein;

interface
uses
 Windows,
 SysUtils,
 Classes,
 MMSystem;
const
 WAV_BUFFERS                 = 8;
 WAV_MASK                 = 7;
 WAV_BUFFER_SIZE         = 1024;
 
 max_filter                    = 44100;
 max_reverb                    = 44100;
 max_reverb_mask               = 2048;

type
 TSmallIntArray = array[0..1]of SmallInt;
 PSmallIntArray = ^TSmallIntArray;

 TWordArray = array[0..0] of Word;
 PWordArray = ^TWordArray;

 TLiveInput = class
 private
       TotalSamples  :DWORD;
       LastSamples   :DWORD;
       Buffer        :PWordArray;
       InBuffer      :PWordArray;
       WaveOut       :HWAVEOUT;
       WaveIn        :HWAVEOUT;
       WaveFormat    :TWAVEFORMATEX;
       WaveInFormat  :TWAVEFORMATEX;
       WaveHeaders   :array[0..WAV_BUFFERS-1]of TWAVEHDR;
       WaveInHeaders :array[0..WAV_BUFFERS-1]of TWAVEHDR;
       sent          :DWORD;
       completed     :DWORD;
       dwBaseTime    :DWORD;
       EnableSound   :boolean;
       function    GetPosition: DWord;
 public
       done:boolean;
       canexit:boolean;
       constructor Create;
       Procedure   Update;
       destructor  Destroy;
 protected

 end;
var
LiveInput     :TLiveInput;
implementation

function TLiveInput.GetPosition: DWord;
var
t1: DWord;
begin
               if dwBaseTime=0 then
               begin
                dwBaseTime:=timeGetTime;
                exit;
               end;
 t1 := timeGetTime - dwBaseTime;
 t1 := t1*WaveFormat.nAvgBytesPerSec div 1000;

 Result := t1;
end;

constructor TLiveInput.Create;
var
       i,j     :integer;
       s,b     :integer;
       res     :MMResult;
begin
 inherited Create;
 SLInput := true;

 FillChar(WaveFormat,Sizeof(TWAVEFORMATEX),#0);
 with WaveFormat do begin
   wFormatTag :=WAVE_FORMAT_PCM;
   nChannels :=1;
   nSamplesPerSec := 44100;
   wBitsPerSample := 16;
   nBlockAlign := wBitsPerSample*nChannels div 8;
   nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
   cbSize := 0;
 end;
 FillChar(WaveInFormat,Sizeof(TWAVEFORMATEX),#0);
 with WaveInFormat do begin
   wFormatTag :=WAVE_FORMAT_PCM;
   nChannels :=1;
   nSamplesPerSec := 44100;
   wBitsPerSample := 16;
   nBlockAlign := wBitsPerSample*nChannels div 8;
   nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
   cbSize := 0;
 end;

 if WaveOutOpen(@WaveOut,0,@WaveFormat,0,0,CALLBACK_NUll) <> MMSYSERR_NOERROR then begin
   EnableSound:=false;
   Exit;
 end;
 if WaveInOpen(@WaveIn,0,@WaveInFormat,0,0,CALLBACK_NUll) <> MMSYSERR_NOERROR then begin
   EnableSound:=false;
   Exit;
 end;

   GetMem(Buffer,WAV_BUFFER_SIZE*WAV_BUFFERS*2);
   GetMem(InBuffer,WAV_BUFFER_SIZE*WAV_BUFFERS*2);
 for i:=0 to WAV_BUFFERS-1 do
 begin
   FillChar(WaveHeaders[i],sizeof(TWAVEHDR),#0);
   WaveHeaders[i].lpData := Pointer(Cardinal(Buffer) + (i*WAV_BUFFER_SIZE*2));
   WaveHeaders[i].dwBufferLength := (WAV_BUFFER_SIZE*2);
   res:=waveOutPrepareHeader(WaveOut, @WaveHeaders[i], sizeof(TWAVEHDR));
   if res<>MMSYSERR_NOERROR then
   begin
   EnableSound:=false;
       exit;
   end;
   FillChar(WaveInHeaders[i],sizeof(TWAVEHDR),#0);
   WaveInHeaders[i].lpData := Pointer(Cardinal(InBuffer) + (i*WAV_BUFFER_SIZE*2));
   WaveInHeaders[i].dwBufferLength := (WAV_BUFFER_SIZE*2);
   res:=waveInPrepareHeader(WaveIn, @WaveInHeaders[i], sizeof(TWAVEHDR));
   if res<>MMSYSERR_NOERROR then
   begin
   EnableSound:=false;
       exit;
   end;
//    waveInAddBuffer(WaveIn,@WaveInHeaders[i], sizeof(TWAVEHDR));
 end;

 EnableSound:=true;
 dwBaseTime:=0;
 b:=0;
 sent:=0;
 completed:=0;
 waveInStart(WaveIn);
end;
procedure  TLiveInput.Update;
var
       i,j     :integer;
begin
       if not(EnableSound)then Destroy;
       while 1 > 0 do
       begin
       if (completed = sent) then
         break;

         if not(WaveHeaders[completed and WAV_MASK].dwFlags and WHDR_DONE)<>0 then
         break;
         completed:= completed + 1;
       end;

       while (((sent - completed)shr 16) < 8) do
       begin
       if (GetPosition/2048 <= sent) then
         break;

/* Тут обработчик заполненного буффера(Шпецеффекты и пр.) */
/* из InBuffer в Buffer      */
/* позиция  = WAV_BUFFER_SIZE*(sent and WAV_MASK)  */

       waveInAddBuffer(WaveIn,@WaveInHeaders[sent and WAV_MASK], sizeof(TWAVEHDR));
       waveOutWrite(WaveOut,@WaveHeaders[sent and WAV_MASK], sizeof(TWAVEHDR));

       sent:= sent + 1;
       if sent>=2000 then
       begin
          sent:=0;
          dwBaseTime:=timeGetTime;
       end;
       end;

end;

destructor TLiveInput.Destroy;
var
       i:integer;
begin
waveOutReset(WaveOut);
waveInReset(WaveIn);
 for i:=0 to WAV_BUFFERS-1 do
 begin
   WaveHeaders[i].lpData := nil;
   waveOutUnPrepareHeader(WaveOut, @WaveHeaders[i], sizeof(TWAVEHDR));
   WaveInHeaders[i].lpData := nil;
   waveInUnPrepareHeader(WaveIn, @WaveInHeaders[i], sizeof(TWAVEHDR));
 end;

 waveOutClose(WaveOut);

 waveInClose(WaveIn);
 FreeMem(Buffer,WAV_BUFFER_SIZE*WAV_BUFFERS*2);
 FreeMem(InBuffer,WAV_BUFFER_SIZE*WAV_BUFFERS*2);
 inherited Destroy;
end;

end.

Всё тут понятно, Начало - Create. Завершение - Destroy,на форму нужно кинуть таймер, шоб он постоянно вызывал проц. Update,пока не пришло время буффера - процедура не дает прохода waveInWrite и waveOutAddBuffer,пардон,waveOutWrite и waveInAddBuffer

Если кому интересно - сташшил я это из сурса Ку2 на си.

---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2004.07.04;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.031 c