Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.12.26;
Скачать: CL | DM;

Вниз

Как определить частоту?   Найти похожие ветки 

 
Mitay   (2004-09-26 09:06) [0]

Народ помогите. Как мне определить частоту звука подоваемого на микрофон?


 
programania ©   (2004-09-26 20:29) [1]

Получить звук с микрофона в массив можно BASS.dll
массив амплитуд преобразовать в массив частот
быстрым преобразованием фурье: alglib.manual.org или ru
найти максимум и опытным путем перевести в значение частоты.
или перемножить элементы массива амплитуд с SIN
разных частот и сложить
где максимум это и есть основная частота
а звука одной частоты в природе не бывает
всегда есть искажения отражения и т.д.


 
newbie   (2004-09-29 15:02) [2]

1)Где найти bass.dll и доки по нему?
2)Есть ли другой способ?


 
programania ©   (2004-09-29 21:04) [3]

1) в Internete
2) есть примерно такой:

procedure TForm1.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
//начало
BufSize := TrackBar1.Position * 500 + 100; Bits16 := CheckBox1.Checked;
with header do begin
  wFormatTag := WAVE_FORMAT_PCM;
  nChannels := 1;  
  nSamplesPerSec := 22050;
  wBitsPerSample := integer(Bits16) * 8 + 8; { 8 / 16 }
  nBlockAlign := nChannels * (wBitsPerSample div 8);
  nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  cbSize := 0;
end;
WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),
  Form1.Handle, 0, CALLBACK_WINDOW);
BufLen := header.nBlockAlign * BufSize;
hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
Buf := GlobalLock(hBuf);
with BufHead do begin
  lpData := Buf;
  dwBufferLength := BufLen;
  dwFlags := WHDR_BEGINLOOP;
end;
WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
GetMem(p, BufSize * sizeof(TPoint));
stop := true;
WaveInStart(WaveIn);
end;
Procedure konec;
begin
WaveInReset(WaveIn);
WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
WaveInClose(WaveIn);
GlobalUnlock(hBuf);
GlobalFree(hBuf);
FreeMem(p, BufSize * sizeof(TPoint));
end;
procedure TForm1.OnWaveIn;
var
i: integer;
data8: PData8;
data16: PData16;
h: integer;
XScale, YScale: single;
begin
//обработка
h := PaintBox1.Height;
XScale := PaintBox1.Width / BufSize;
if Bits16 then begin
  data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
  YScale := h / (1 shl 16);
  for i := 0 to BufSize - 1 do
    p^[i] := Point(round(i * XScale),
      round(h / 2 - data16^[i] * YScale));
end else begin
  Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);
  YScale := h / (1 shl 8);
  for i := 0 to BufSize - 1 do
    p^[i] := Point(round(i * XScale),
      round(h - data8^[i] * YScale));
end;
end;



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

Текущий архив: 2004.12.26;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.059 c
14-1102171935
sof_
2004-12-04 17:52
2004.12.26
IP адрес и доступ к дискам по сети


14-1102412396
Dmitriy O.
2004-12-07 12:39
2004.12.26
Кто знает какие либо методы быстрого сброса данных В Эксель ?


1-1102861942
ASDFGH
2004-12-12 17:32
2004.12.26
Перевод в верхний регистр не работает.


6-1097481189
Stef
2004-10-11 11:53
2004.12.26
Определение сетевых групп


14-1102278234
Youri1
2004-12-05 23:23
2004.12.26
Проэкт базы даных