Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Измерить частоту с микрофона, частотомер 
:(
    Опции темы
344092
Дата 19.6.2008, 09:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 54
Регистрация: 3.6.2006

Репутация: нет
Всего: нет
Приветствую Вас

Есть необходимость замерить частоту звука с микрофона , например подношу к микрофону пищалку а прога пишет частоту сигнала .... Вот не знаю с чего начать  smile 

P.S В последствии хотелось бы измерять сигнал с голосового модема (Звоню модемом по номеру на том конце поднимают трубку и вещают сигнал с частотой 8кгЦ , а прога должна показать что да! тут 8 кгЦ)

заранее Спасибо
PM MAIL   Вверх
Alexeis
Дата 19.6.2008, 09:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
344092, берешь фрагмент, сэмплов эдак 256 - 1024 прогоняешь через фурье, получаешь спектр, находишь максимум спектра, это и будет искомая частота smile .


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
344092
Дата 19.6.2008, 09:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 54
Регистрация: 3.6.2006

Репутация: нет
Всего: нет
Мне нужно в реальном времени, Это возможно?

Цитата

берешь фрагмент, сэмплов эдак 256 - 1024 прогоняешь через фурье, получаешь спектр, находишь максимум спектра, это и будет искомая частота  .


А где посмотреть конкретный пример....
PM MAIL   Вверх
Ak47black
Дата 19.6.2008, 12:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: нет
Всего: 0
Тебе нужно заглянуть в DRKB3->Снятие звука с микрофона, отображение звуковые данных в виде графика
Там пример графика частоты.
Код

unit Unit1;

interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Forms,
Dialogs, MMSystem;
 

type
TWavArrayBuf = array[0..1023]of byte;
PWavArrayBuf = ^TWavArrayBuf;

 
TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);

private
   WaveFormat: TWaveFormatEx;
   WaveIn: PHWaveIn;
   procedure WndProc(var Msg: TMessage); override;
   function InitWaveIn: Boolean;
   procedure CloseWaveIn;
end;
 
var
Form1: TForm1;

 implementation

uses Math;
 
{$R *.dfm}

function TForm1.InitWaveIn: Boolean;
var
I, Err: Integer;
WaveHdr: PWaveHdr;
WavBuff: PWavArrayBuf;


procedure FreeData;
begin
   if WavBuff <> nil then Dispose(WavBuff);
   if WaveHdr <> nil then Dispose(WaveHdr);
   if WaveIn <> nil then Dispose(WaveIn);
end;

 begin
Result := False;
WaveFormat.wFormatTag := WAVE_FORMAT_PCM;
WaveFormat.nChannels := 1; 
WaveFormat.nSamplesPerSec := 44100;
WaveFormat.nAvgBytesPerSec := 44100;
WaveFormat.nBlockAlign := 4;
WaveFormat.wBitsPerSample := 8;
WaveIn := New(PHWaveIn);
Err := WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW);
if Err <> 0 then Exit;
for i:=1 to 8 do
begin
   WavBuff := New(PWavArrayBuf);
   WaveHdr := New(PWaveHdr);
   with WaveHdr^ do
   begin
     lpData := Pointer(WavBuff);
     dwBufferLength := SizeOf(WavBuff);
     dwBytesRecorded := 0;
     dwUser := 0;
     dwFlags := 0;
     dwLoops := 0;
   end;

   Err := WaveInPrepareHeader(WaveIn^, WaveHdr, SizeOf(TWaveHdr));
   if Err <> 0 then
   begin
     FreeData;
     Exit;
   end;

   Err := WaveInAddBuffer(WaveIn^, WaveHdr, Sizeof(TWaveHdr));
   if Err <> 0 then
   begin
     FreeData;
     Exit;
   end;

end;

Err := WaveInStart(WaveIn^);
if Err <> 0 then
begin
   FreeData;
   Exit;
end;

Result := True;

end;

 

Procedure Tform1.WndProc(var Msg: TMessage);
var
Hdr: PWaveHdr;
I: Integer;
R: Real;
begin
inherited;
case Msg.Msg of
   MM_WIM_DATA:
   begin
     Hdr := PWaveHdr(Msg.LParam);
     if Hdr^.dwBytesRecorded = 0 then Exit;
     R := IfThen(Hdr^.dwBytesRecorded > 0,
       ClientWidth / Hdr^.dwBytesRecorded, 0);
     PatBlt(Canvas.Handle, 0, 0, ClientWidth,  ClientHeight, PATCOPY);
     Canvas.Pen.Color:=clRed;
     Canvas.MoveTo(0, 127);
     Canvas.LineTo(ClientWidth, 127);
     Canvas.Pen.Color := clMaroon;
     for I := 1 to 12 do
     begin
       Canvas.MoveTo(Round(R * (I * 100)), 0);
       Canvas.LineTo(Round(R * (I * 100)), 255);
     end;

     Canvas.Pen.Color:=clLime;
     Canvas.MoveTo(0, PWavArrayBuf(Hdr.lpData)^[0]);
     for I := 0 to Hdr^.dwBytesRecorded - 1 do
       Canvas.LineTo(Round(R * I), PWavArrayBuf(Hdr.lpData)^[I]);

      WaveInUnprepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));
     Dispose(hdr.lpData);
     DisPose(hdr);

      Hdr := New(PWaveHdr);
     Hdr^.lpData := Pointer(New(PWavArrayBuf));
     Hdr^.dwBufferLength := 1024;
     Hdr^.dwBytesRecorded := 0;
     Hdr^.dwUser := 0;
     Hdr^.dwFlags := 0;
     Hdr^.dwLoops := 0;

     WaveInPrepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));
     WaveInAddBuffer(WaveIn^, Hdr, Sizeof(TWaveHdr));
   end;
end;

end;

 

procedure TForm1.CloseWaveIn;
begin
WaveInStop(WaveIn^);
if WaveIn <> nil then
begin
   WaveInReset(WaveIn^);
   WaveInClose(WaveIn^);
end;

Dispose(WaveIn);

end;
 

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
Height := 282;
Width := 1000;
Color := clBlack;
if not InitWaveIn then ShowMessage(SysErrorMessage(GetLastError));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseWaveIn;
end;
 
end.


(пробелы уберёшь)
PM MAIL   Вверх
Alexeis
Дата 19.6.2008, 14:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(344092 @  19.6.2008,  08:58 Найти цитируемый пост)
А где посмотреть конкретный пример.... 

  В DRKB.  smile 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Shamitoff
Дата 2.12.2010, 00:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 2.12.2010
Где: Россия

Репутация: нет
Всего: нет
Можете помочь с кодом из DRKB? Все написано без комментариев и очень сложно понять что как и зачем делает код smile 
PM ICQ Skype   Вверх
Alexeis
Дата 2.12.2010, 01:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Shamitoff, производиться запись звука при помощи WaveIn API с последующим выводом сигнала на экран. В этом примере частота непосредственно не измеряется. Главное что тут есть доступ к буферу аудио данных PWavArrayBuf(Hdr.lpData)^[I] . Дальше можно делать произвольный анализ.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Shamitoff
Дата 2.12.2010, 12:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 2.12.2010
Где: Россия

Репутация: нет
Всего: нет
так, вроде разбираться начинаю. Мне только не понятно, куда выводится графическая инфа? Надо создать какой нибудь компонент? Не на голую же форму выводиться будет=)
PM ICQ Skype   Вверх
Alexeis
Дата 2.12.2010, 21:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(Shamitoff @  2.12.2010,  13:24 Найти цитируемый пост)
Не на голую же форму выводиться будет=) 

В данном случае именно так и выводиться, но разумеется, это поведение можно изменить.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Shamitoff
Дата 2.12.2010, 22:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 2.12.2010
Где: Россия

Репутация: нет
Всего: нет
просто копирую код в делфи, запускаю и ничего не происходит. Может что нибудь подключить дополнительно надо? или на форму добавить? smile 
PM ICQ Skype   Вверх
Alexeis
Дата 2.12.2010, 22:44 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(Shamitoff @  2.12.2010,  23:38 Найти цитируемый пост)
Может что нибудь подключить дополнительно надо? 

  Микрофон  smile . Вообще нужно выбрать устройство записи по умолчанию и прибавить громкости.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Shamitoff
Дата 2.12.2010, 23:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 2.12.2010
Где: Россия

Репутация: нет
Всего: нет
Цитата(Alexeis @ 2.12.2010,  22:44)
Цитата(Shamitoff @  2.12.2010,  23:38 Найти цитируемый пост)
Может что нибудь подключить дополнительно надо? 

  Микрофон  smile . Вообще нужно выбрать устройство записи по умолчанию и прибавить громкости.

А вы не пробовали программу запускать? У вас работает?) У меня вообще ноль. После компиляции чистая форма)
PM ICQ Skype   Вверх
Alexeis
Дата 3.12.2010, 00:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(Shamitoff @  3.12.2010,  00:36 Найти цитируемый пост)
У меня вообще ноль. После компиляции чистая форма) 

автор чуток ошибся 
вот тут 
  WaveFormat.nBlockAlign   := 1; //блок данных в данном случае состоит из одного сэмпла 8 бит = 1 байт
забыл добавить это
  WaveFormat.cbSize          := sizeof(WaveFormat);
и почему-то указал 0 вместо WAVE_MAPPER в качестве второго параметра
  Err := WaveInOpen(WaveIn, WAVE_MAPPER, @WaveFormat, Handle, 0, CALLBACK_WINDOW);


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Shamitoff
Дата 3.12.2010, 00:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 2.12.2010
Где: Россия

Репутация: нет
Всего: нет
Цитата(Alexeis @ 3.12.2010,  00:21)
Цитата(Shamitoff @  3.12.2010,  00:36 Найти цитируемый пост)
У меня вообще ноль. После компиляции чистая форма) 

автор чуток ошибся 
вот тут 
  WaveFormat.nBlockAlign   := 1; //блок данных в данном случае состоит из одного сэмпла 8 бит = 1 байт
забыл добавить это
  WaveFormat.cbSize          := sizeof(WaveFormat);
и почему-то указал 0 вместо WAVE_MAPPER в качестве второго параметра
  Err := WaveInOpen(WaveIn, WAVE_MAPPER, @WaveFormat, Handle, 0, CALLBACK_WINDOW);

Исправил. Все так же.

У меня программа ни разу не проходит по кейсу. Строка 99. Может с условием не то что-то? smile 
PM ICQ Skype   Вверх
Shamitoff
Дата 3.12.2010, 01:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 2.12.2010
Где: Россия

Репутация: нет
Всего: нет
Alexeis, спасибо большое! Разобрался, все работает!  smile 
PM ICQ Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0848 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.