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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Звуковая карта, Работа со звуковой картой в Делфи 
:(
    Опции темы
Андрей
  Дата 18.7.2002, 11:44 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Кто то пытался записать сигнал через микрофонный вход саунд карты (или любой другой вход) в файл а потом работать с этим файлом (цифирями) в своей программе. если да, то поделитесь опытом!!!
  Вверх
podval
Дата 18.7.2002, 15:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Где я? Кто я?
****


Профиль
Группа: Экс. модератор
Сообщений: 3094
Регистрация: 25.3.2002
Где: СПб

Репутация: нет
Всего: 62
Файлы *.wav интересуют? А что конкретно? Тут Mikel этим занимается.
PM WWW ICQ   Вверх
МММ
Дата 19.7.2002, 01:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 1
Можно на диск записать с помощью стандарного TMediaPlayer, а потом анализировать формат!!!


--------------------
Аренда VPS хостинга в России
x6x.ru
PM MAIL   Вверх
Mikel
Дата 19.7.2002, 07:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 1
Всего: 2
У меня где-то была статья на винте про запись с микрофона и работу с SoundBlaster'ом. Найду, выложу, или дам link.


--------------------
...so remember, it's better to burn out than to fade away
PM MAIL ICQ   Вверх
Mikel
Дата 19.7.2002, 08:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 1
Всего: 2
Если надо про Sound Blaster, то тут
Кстати, интересные вещи пишут
--------------------------------
http://www.torry.net/audio.htm
-есть компонент для микрофона, но для билдера :huh


--------------------
...so remember, it's better to burn out than to fade away
PM MAIL ICQ   Вверх
Vit
Дата 19.7.2002, 15:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Vitaly Nevzorov
****


Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 1
Всего: 207
Взято из рассылки: http://Subscribe.Ru/catalog/comp.soft.prog.delphi4all

Как считать сигнал с микрофона
В Windows нет разделения каналов записи по источникам.
CD-ROM ----------|
                |             |--- Динамики
Микрофон --------|             |
                |-- Windows --|--- Записывающие программы
Линейный вход ---|             |
                |             |--- Линейный выход
MIDI ------------|
Все поступающие в систему звуки смешиваются, и лишь после этого их получает программа.
Для получения звукового сигнала нужно воспользоваться WinAPI. WaveInOpen открывает доступ к микрофону. Одновременно только одна программа может работать с микрофоном. Заодно Вы указываете, какая нужна частота, сколько бит на значение и размер буфера. От последнего зависит, как часто и в каком объеме информация будет поступать в программу.
Далее нужно выделить память для буфера и вызвать функцию WaveInAddBuffer, которая передаст Windows пустой буфер. После вызова WaveInStart Windows начнет заполнять буфер, и, после его заполнения, пошлет сообщение MM_WIM_DATA. В нем нужно обработать полученную информацию и вновь вызвать WaveInAddBuffer, тем самым указав, что буфер пуст.
Функции WaveInReset и WaveInClose прекратят поступление информации в программу и закроют доступ к микрофону.
Эта программа считывает сигнал с микрофона и выводит его на экран. Частота сигнала - 22050 Гц. Количество бит определяется флажком, размер буфера TrackBar-ом.
Код

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem;

type
 TData8 = array [0..127] of byte;
 PData8 = ^TData8;
 TData16 = array [0..127] of smallint;
 PData16 = ^TData16;
 TPointArr = array [0..127] of TPoint;
 PPointArr = ^TPointArr;
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   PaintBox1: TPaintBox;
   TrackBar1: TTrackBar;
   CheckBox1: TCheckBox;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure CheckBox1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

var
 WaveIn: hWaveIn;
 hBuf: THandle;
 BufHead: TWaveHdr;
 bufsize: integer;
 Bits16: boolean;
 p: PPointArr;
 stop: boolean = false;

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 TForm1.Button2Click(Sender: TObject);
begin
 if stop = false then Exit;
 stop := false;
 while not stop do Application.ProcessMessages;
 stop := false;
 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;
 with PaintBox1.Canvas do begin
   Brush.Color := clWhite;
   FillRect(ClipRect);
   Polyline(Slice(p^, BufSize));
 end;
 if stop
   then WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),
     SizeOf(TWaveHdr))
   else stop := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 Button2.Click;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 if stop then begin
   Button2.Click;
   Button1.Click;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 TrackBar1.OnChange := CheckBox1Click;
 Button1.Caption := 'Start';
 Button2.Caption := 'Stop';
 CheckBox1.Caption := '16 / 8 bit';
end;

end.

Автор: Даниил Карапетян




--------------------
With the best wishes, Vit
I have done so much with so little for so long that I am now qualified to do anything with nothing
Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru
PM MAIL WWW ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

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

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

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

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

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

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


 




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


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

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