| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Измерение уровня входного сигнала звуковой карты [D6, D7, WinXP]
Acidlex © (2006-04-10 16:01:00)Помогите решить задачу
Нужно измерить уровень сигнала на входе микрофона и линейном входе в реальном времени
Задача: написать что то вроде осцилографа с возможностью использования нескольких звуковых карт.
Сергей М. (2006-04-28 09:03:00) [1]
> Две то по любому встанут, а вот больше...
И больше тоже встанут.
В моей практике имелась одновременная работа с 4-мя картами на борту - SB Audigy2, SBLive, Realtek и CrystalSound. Ресурсы системы при этом были выделены вполне корректно.
> Acidlex (27.04.06 13:54) [6]
>
> использование нескольких источников записи одновременно
> (CD, Line in, Aux ....)?
Микшер AC'97-кодека такое не позволяет. Либо запись с одного источника, либо с другого, но не с нескольких одновременно.
Deka (2006-04-27 16:16:00) [2]IMHO можно использовать несколько звуковых карт на компе. Да и запись наверное можно вести, если позволяет карта. Запись наверное ведется при помощи DMA, дабы не тормозить проц. Правда каналов DMA мало и если карта сможет последовательно переключать каналы DMA и соотвественно их настраивать для записи звука из источников в выделенные буферы - то нет проблем.
Лучше всего будет сделать своб железяку. Знаю - непросто, дорого и долго. Зато будет реализована вся необходимая функциональность. Для пяти каналов надо как минимум 3 звуковые карты. Это уже перебор. Две то по любому встанут, а вот больше... А профессиональную звуковую карту поискать не пробовал? Может быть у них есть куча входных каналов?
Acidlex (2006-04-27 13:54:00) [3]Еще вопрос: Использование нескольких звуковых карт на обном компе, это реально ???
Или использование нескольких источников записи одновременно (CD, Line in, Aux ....)?
Вобщем надо снимать сигнал с 5 и более каналов.
Acidlex (2006-04-12 12:25:00) [4]Большое спасибо :)
Rouse_ (2006-04-11 10:05:00) [5]
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.
Сергей М. (2006-04-11 09:26:00) [6]Используй, например, bass.dll.
Или Intel SPL suite (там есть готовый демо-проект в т.ч. с реализованным осциллографом реального времени)
Acidlex (2006-04-11 09:12:00) [7]Ничего из перечисленного :) Все это уже в прошлом :))))))))))))
Друг попросил помочь
Он работает на заводе, и нада такая вот прога для диагностики
Сергей М. (2006-04-10 16:31:00) [8]А до сдачи курсового (работы, зачета, лабы - нужное подчеркнуть осталось всего ничего ..
| |
