ru.algorithms

 
 - RU.ALGORITHMS ----------------------------------------------------------------
 From : …ўЈҐ­Ё© Њ иҐа®ў                      2:5020/175.2   10 Dec 2001  20:47:26
 To : Roman Kirillov
 Subject : Построение сонограммы (спектрограмма)
 -------------------------------------------------------------------------------- 
 

 Mon Dec 03 2001 22:15, Roman Kirillov wrote to All:
 
  RK> Вот собственно с сабжем ну никак не могу pазобpаться! Подскажите кто
  RK> знает, исходники на С/С++, Паскале, Бейсике и куче дpугих языков
  RK> пpиветствуются! :-) 
  
 Строим серию спектров, накладывая соответственное окно.
 Для каждого выводим столбик на экране, яркости точек которого соответствуют
 мощности на данной частоте. 
 procedure fft(var Ar:array of double; var Ai:array of double);
 var
 Le,Le1,jt,it,ip,lt,kt:Integer;
 Tr,Ti,Ur,Ui,Wr,Wi:Double;
 
 begin
      for it:=0 to 255 do
      begin
      kt:=128;
      jt:=0;
      Le:=1;
      Le1:=it;
      for lt:=1 to 8 do
      begin
       if kt<=Le1 then begin
       jt:=jt+Le;
       Le1:=Le1-kt;
       end;
       Le:=Le*2;
       kt:=kt div 2;
      end;
      if it<jt then begin
         Tr:=Ar[jt];Ti:=Ai[jt];
         Ar[jt]:=Ar[it];Ai[jt]:=Ai[it];
         Ar[it]:=Tr;Ai[it]:=Ti;
         end;
      end;
 
      for lt:=1 to 8 do
      begin
       Le:=1;
       for jt:=1 to lt do Le:=Le*2;
       Le1:=Le div 2;
       Ur:=1.0;
       Ui:=0.0;
       Wr:=cos(Pi/Le1);
       Wi:=sin(Pi/Le1);
       for jt:=0 to Le1-1 do
       begin
        it:=jt;
        while it<256-Le1 do
        begin
         ip:=it+Le1;
         Tr:=Ar[ip]*Ur-Ai[ip]*Ui;
         Ti:=Ar[ip]*Ui+Ai[ip]*Ur;
         Ar[ip]:=Ar[it]-Tr;
         Ai[ip]:=Ai[it]-Ti;
         Ar[it]:=Ar[it]+Tr;
         Ai[it]:=Ai[it]+Ti;
         it:=it+Le;
        end;
       Tr:=Ur*Wr-Ui*Wi;
       Ti:=Ur*Wi+Ui*Wr;
       Ur:=Tr;
       Ui:=Ti;
       end;
      end;
 end;
 
 Это было Фурье
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
        for i:=1 to sNs do
         Ws[i]:=(0.54-0.46*cos(2*Pi*(i-0.5)/sNs));
        if(OpenDialog1.Execute) then begin
        Button1.Enabled:=false;
        AssignFile(FromF, OpenDialog1.FileName);
        Reset(FromF,1);
        BlockRead(FromF,wavHfrom,sizeof(wavHfrom));
        Nin:=wavHfrom.DataSize div 2;
        SetLength(Din,Nin+800);
        BlockRead(FromF,Din[0],wavHfrom.DataSize);
        Nb:=500;
        for i:=0 to 255 do
         sPow[i]:=0.0;
        for i:= 0 to 499 do
        begin
        S:=0.0;
        l:=0;
         for j:=0 to 255 do begin
             Ar[j]:=Din[Trunc(Nin/500.0*i)+j]*Ws[j+1];
             S:=S+Ar[j];
             Ai[j]:=0.0;
             end;
         S:=S/256;
         for j:=0 to 255 do Ar[j]:=Ar[j]-S;
         fft(Ar,Ai);
         for j:=0 to 255 do
          Spow[j]:=Ar[j]*Ar[j]+Ai[j]*Ai[j];
        S:=0.0;
        for j:=0 to 255 do
        begin
        Spow[j]:=sqrt(Spow[j]);
        if S<Spow[j] then S:=Spow[j];
        end;
        for j:=0 to 127 do
        begin
         Image1.Canvas.Pen.Color:=RGB(Trunc(Spow[j]/70000*255),0,0);
         Image1.Canvas.MoveTo(i,254-2*j);
         Image1.Canvas.LineTo(i,252-2*j);
        end;
        end;
        CloseFile(FromF);
        wavHto:=wavHfrom;
        Button1.Enabled:=true;
        end;
      end;
 
 А это сам рисователь.
 
 Евгений Машеров АКА СанитарЖеня
 
 --- ifmail v.2.15
  * Origin: FidoNet Online - http://www.fido-online.com (2:5020/175.2)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор 

Тема:    Автор:    Дата:    Построение сонограммы (спектрограмма)   Roman Kirillov   03 Dec 2001 23:15:15   Построение сонограммы (спектрограмма)   …ўЈҐ­Ё© Њ иҐа®ў   10 Dec 2001 20:47:26