Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.07.2014, 22:02   #11
Karateka
Пользователь
 
Регистрация: 25.05.2013
Сообщений: 33
По умолчанию

Код:
unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TArrayValues = array of Double;
  TSingleArray = array of Single;
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormatWAVE();
    procedure FFT(var a : TSingleArray; nn : Integer; InverseFFT : Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
 n = 4096;

var
  Form1: TForm1;
  Memo1 : TMemo;
  OpenDialog : TOpenDialog;
  _PathFile : string;
   data : TSingleArray;
   FTvl : TArrayValues;
   data2 : TSingleArray;
   Nvl, Nft : integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 OpenDialog := TOpenDialog.Create(self);
 OpenDialog.Filter := 'WAV | *.wav';
  if OpenDialog.Execute then
   else Exit;
 _PathFile := OpenDialog.FileName;
 OpenDialog.Free;
end;

procedure TForm1.FormatWAVE();
var
 FileWAVE : file;
 FileDATA : file;
 FileTXT : textfile;
 _FileWAVE : TFileStream;
 _NC: integer;
 i: Integer;
 _AllStructurWAVE : array [0..43] of byte;
 RIFF : array [0..3] of ansichar;
 chunkSize : cardinal;
 WAVE : array [0..3] of ansichar;
 FMT : array [0..3] of ansichar;
 subchunk1Size : integer;
 audioFormat : smallint;
 numChannels : smallint;
 sampleRate : cardinal;
 byteRate : cardinal;
 blockAlign : smallint;
 bitsPerSample : smallint;
 subChunk2ld : array [0..3] of ansichar;
 subChunk2Size : cardinal;

begin

 _FileWAVE := TFileStream.Create(_PathFile, fmOpenRead);
 Memo1.Lines.Add('Заголовок WAVE файла');

 _FileWAVE.Read(RIFF, length(RIFF));
 Memo1.Lines.Add('0-3 байт ' + RIFF);

 _FileWAVE.Read(chunkSize, SizeOf(chunkSize));
 Memo1.Lines.Add('4-7 байт ' + IntToStr(chunkSize));

 _FileWAVE.Read(WAVE, length(WAVE));
 Memo1.Lines.Add('8-11 байт ' + WAVE);

 _FileWAVE.Read(FMT, length(FMT));
 Memo1.Lines.Add('12-15 байт ' + FMT);

 _FileWAVE.Read(subchunk1Size, SizeOf(subchunk1Size));
 Memo1.Lines.Add('16-19 байт ' + IntToStr(subchunk1Size) + ' - [1 для PCM]');

 _FileWAVE.Read(audioFormat, SizeOf(audioFormat));
 Memo1.Lines.Add('20-21 байт ' + IntToStr(audioFormat) + ' - [1 для PCM]');

 _FileWAVE.Read(numChannels, SizeOf(numChannels));
 Memo1.Lines.Add('22-23 байт ' + IntToStr(numChannels) + ' - [Моно = 1, Стерео = 2]');

 _FileWAVE.Read(sampleRate, SizeOf(sampleRate));
 Memo1.Lines.Add('24-27 байт ' + IntToStr(sampleRate) + ' - [Частота дискретизации]');

 _FileWAVE.Read(byteRate, SizeOf(byteRate));
 Memo1.Lines.Add('28-31 байт ' + IntToStr(byteRate) + ' - [Количество байт, переданных за секунду воспроизведения.]');

 _FileWAVE.Read(blockAlign, SizeOf(blockAlign));
 Memo1.Lines.Add('32-33 байт ' + IntToStr(blockAlign) + ' - [Количество байт для одного сэмпла, включая все каналы.]');

 _FileWAVE.Read(bitsPerSample, SizeOf(bitsPerSample));
 Memo1.Lines.Add('34-35 байт ' + IntToStr(bitsPerSample) + ' - [Количество бит в сэмпле. Так называемая "глубина" или точность звучания.]');

 _FileWAVE.Read(subChunk2ld, length(subChunk2ld));
 Memo1.Lines.Add('36-39 байт ' + subChunk2ld);

 _FileWAVE.Read(subChunk2Size, SizeOf(subChunk2Size));
 Memo1.Lines.Add('40-43 байт ' + IntToStr(subChunk2Size) + ' - [Количество байт в области данных.]');

 _FileWAVE.Free;

 SetLength(data,subChunk2Size);

 AssignFile(FileDATA, _PathFile);
  Reset(FileDATA,1);
  seek(FileDATA,44);
   BlockRead(FileDATA,data[0],subChunk2Size,_NC);
    CloseFile(FileDATA);


 SetLength(data2,n*2);

 for i := 0 to n*2-1 do
     begin
      data2[i]:= data[i];
     end;

  FFT(data2,n,false);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 i : integer;
begin
 FormatWAVE();
end;
Karateka вне форума Ответить с цитированием
Старый 12.07.2014, 22:03   #12
Karateka
Пользователь
 
Регистрация: 25.05.2013
Сообщений: 33
По умолчанию

Код:
procedure TForm1.FFT(var a : TSingleArray;
     nn : Integer;
     InverseFFT : Boolean);
var
    ii, jj, n, mmax, m, j, istep, i, isign : Integer;
    wtemp, wr, wpr, wpi, wi, theta, tempr, tempi : Double;
begin
    if InverseFFT then isign := -1
    else isign := 1;
    n := 2*nn; j := 1; ii:=1;
    while ii <= nn do
    begin
        i := 2*ii-1;
        if j>i then
        begin
            tempr := a[j-1];
            tempi := a[j];
            a[j-1] := a[i-1];
            a[j] := a[i];
            a[i-1] := tempr;
            a[i] := tempi;
        end;
        m := n div 2;
        while (m>=2) and (j>m) do
        begin
            j := j-m;
            m := m div 2;
        end;
        j := j+m;
        Inc(ii);
    end;
    mmax := 2;
    while n>mmax do
    begin
        istep := 2*mmax;
        theta := 2*Pi/(isign*mmax);
        wpr := -2.0*sqr(sin(0.5*theta));
        wpi := sin(theta);
        wr := 1.0;
        wi := 0.0;
        ii:=1;
        while ii<=mmax div 2 do
        begin
            m := 2*ii-1;
            jj:=0;
            while jj<=(n-m) div istep do
            begin
                i := m+jj*istep;
                j := i+mmax;
                tempr := wr*a[j-1]-wi*a[j]; // обычно вылетает здесь
                tempi := wr*a[j]+wi*a[j-1];
                a[j-1] := a[i-1]-tempr; // обычно вылетает здесь
                a[j] := a[i]-tempi;
                a[i-1] := a[i-1]+tempr;
                a[i] := a[i]+tempi;
                Inc(jj);
            end;
            wtemp := wr;
            wr := wr*wpr-wi*wpi+wr;
            wi := wi*wpr+wtemp*wpi+wi;
            Inc(ii);
        end;
        mmax := istep;
    end;
    if InverseFFT then
    begin
        I:=1;
        while I<=2*nn do
        begin
            a[I-1] := a[I-1]/nn;
            Inc(I);
        end;
    end;
end;

end.
Не могу разобраться из-за чего вылетает из процедуры FFT, пишет "floating point invalid operation at 0x0051a361".
Karateka вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание Wav-файла DelhiProgramer Мультимедиа в Delphi 1 13.08.2012 14:14
Обработка и запись WAV Voxa7 Помощь студентам 2 13.03.2011 11:28
декомпиляция Wav файла DzetaHunter Общие вопросы Delphi 3 14.01.2011 13:17
Анализ Wav файла lacost Общие вопросы по Java, Java SE, Kotlin 4 17.12.2010 12:09
Спектр wav файла varvara16 Мультимедиа в Delphi 3 01.02.2010 08:10