Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как создать "розовый" шум (pink noise) c библиотекой BASS? [D7, WinXP]


Dr. Andrew ©   (2005-06-03 14:50:00) 

Как создать "розовый" (pink noise) шум (например, шум леса или ручья) требуемых частот, используя исключительно библиотеку BASS? Мастера, пожалуйста, приведите конкретный пример или приведите ссылку на конкретный пример. Всем спасибо за помощь!


XProger   (2005-06-06 16:20:00) [1]

thx!


Thaddy   (2005-06-06 00:48:00) [2]

Or look at www.musicdsp.org for examples and filters


Thaddy   (2005-06-06 00:47:00) [3]

Or look at www.musicdsp.org for examples and filters


XProger   (2005-06-05 04:25:00) [4]

Благодаря programania хоть услышал что это такое :)
Для этого маленькую программку написал, если кому интересно...

program noise;

uses
Windows;

const
d  = 5;    
f  = 22050;
t1 = 1;  
t2 = 4;  

type
tb = array [0..1] of SmallInt;

TWav_Header = record
 riff            : array [0..3] of Char;
 filesize        : DWORD;
 rifftype        : array [0..3] of Char;
 chunk_id1       : array [0..3] of Char;
 chunksize1      : DWORD;
 wFormatTag      : Word;
 nChannels       : Word;
 nSamplesPerSec  : DWORD;
 nAvgBytesPerSec : DWORD;
 nBlockAlign     : Word;
 wBitsPerSample  : Word;
 chunk_id2       : array [0..3] of char;
 chunksize2      : DWORD;
end;

var
data: ^tb;

var
i, j, q, s1, s2, a : integer;
r   : boolean;
Fo  : File of Byte;
wav : TWav_Header;
begin
AssignFile(Fo, 'noise.wav');
Rewrite(Fo);

q := f*d;
GetMem(data, q*2);
s1 := t1*f;
s2 := t2*f;
i  := 0;
r  := true;

for j := 0 to q - 1 do
begin
if r then
 begin
 inc(i);
 a := 1024*i div s1;
 end
else
 begin
 dec(i);
 a := 1024*i div s2;
 end;

if r and (i > s1) then
 begin
 r := false;
 i := s2;
 end;

if i = 0 then r := true;

data^[j] := (random(64000)-32000)*a div 1024;

if (j > 0) and r then
 data^[j] := (data^[j] + data^[j-1])*3 div 4
end;

with wav do
begin
riff            := 'RIFF';
filesize        := q*2 + sizeof(wav) - 8;
rifftype        := 'WAVE';
chunk_id1       := 'fmt ';
chunksize1      := 16;
wFormatTag      := 1;
nChannels       := 1;
nSamplesPerSec  := f;
nAvgBytesPerSec := 2*f;
nBlockAlign     := 2;
wBitsPerSample  := 16;
chunk_id2       := 'data';
chunksize2      := q * 2;
end;
BlockWrite(Fo, wav, sizeof(wav));
BlockWrite(Fo, data^[0], q*2);
CloseFile(Fo);
FreeMem(data);
end.

А не подскажет ли кто-нибудь ссылочку по описанию подобных алгоритмов? :)


programania   (2005-06-05 01:46:00) [5]


procedure TForm1.Button2Click(Sender: TObject);
const
d=5;    //длина шума в сек
f=22050;//частота
t1=1;   //время увеличения
t2=4;   //уменьшения

type
tb=array[0..f*d] of smallInt;

var
data:^tb;

var
i,j,h,q,s1,s2,a:integer; r:boolean;
begin
q:=f*d;
BASS_Init(-1, q, 0, application.handle);
BASS_Start;
data:=BASS_SampleCreate(q, f, 1, BASS_SAMPLE_MONO or BASS_SAMPLE_LOOP);
s1:=t1*f;
s2:=t2*f;
i:=0;
r:=true;

for j:=0 to q-1 do begin

 if r then begin inc(i);a:=1024*i div s1 end
      else begin dec(i);a:=1024*i div s2 end;
 if r and (i>s1) then begin r:=false; i:=s2 end;
 if i=0  then r:=true;

 data^[j]:=(random(64000)-32000)*a div 1024;
//розоватость шума в начале:
 if (j>0)and r then data^[j]:=(data^[j]+data^[j-1])* 3 div 4;
end;

h:=BASS_SampleCreateDone;
BASS_SamplePlayEx(h, 0{start},f,100{volume}, 0{pan}, true{loop});
end;


Jeer   (2005-06-03 18:29:00) [6]

Белый шум это Random или RandG из Delphi:)


Dr. Andrew   (2005-06-03 17:27:00) [7]

Хорошо. Тогда подскажите как с помощью библиотеки BASS создать белый шум. Пожалуйста, практический пример. Спасибо!


Jeer   (2005-06-03 16:42:00) [8]

Шум леса или ручья (тем более) это не розовый шум.

Розовый шум это белый шум обработанный плоским фильтром низких частот.


Наверх

Титульная страница Поиск, карта сайта Написать письмо