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

Вниз

Измерение уровня входного сигнала звуковой карты   Найти похожие ветки 

 
Acidlex   (2006-04-10 16:01) [0]

Помогите решить задачу
Нужно измерить уровень сигнала на входе микрофона и линейном входе в реальном времени

Задача: написать что то вроде осцилографа с возможностью использования нескольких звуковых карт.


 
Сергей М. ©   (2006-04-10 16:31) [1]

А до сдачи курсового (работы, зачета, лабы - нужное подчеркнуть осталось всего ничего ..


 
Acidlex   (2006-04-11 09:12) [2]

Ничего из перечисленного :) Все это уже в прошлом :))))))))))))

Друг попросил помочь
Он работает на заводе, и нада такая вот прога для диагностики


 
Сергей М. ©   (2006-04-11 09:26) [3]

Используй, например, bass.dll.

Или Intel SPL suite (там есть готовый демо-проект в т.ч. с реализованным осциллографом реального времени)


 
Rouse_ ©   (2006-04-11 10:05) [4]

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.


 
Acidlex   (2006-04-12 12:25) [5]

Большое спасибо :)


 
Acidlex   (2006-04-27 13:54) [6]

Еще вопрос: Использование нескольких звуковых карт на обном компе, это реально ???
Или использование нескольких источников записи одновременно (CD, Line in, Aux ....)?

Вобщем надо снимать сигнал с 5 и более каналов.


 
Deka ©   (2006-04-27 16:16) [7]

IMHO можно использовать несколько звуковых карт на компе. Да и запись наверное можно вести, если позволяет карта. Запись наверное ведется при помощи DMA, дабы не тормозить проц. Правда каналов DMA мало и если карта сможет последовательно переключать каналы DMA и соотвественно их настраивать для записи звука из источников в выделенные буферы - то нет проблем.
Лучше всего будет сделать своб железяку. Знаю - непросто, дорого и долго. Зато будет реализована вся необходимая функциональность. Для пяти каналов надо как минимум 3 звуковые карты. Это уже перебор. Две то по любому встанут, а вот больше... А профессиональную звуковую карту поискать не пробовал? Может быть у них есть куча входных каналов?


 
Сергей М. ©   (2006-04-28 09:03) [8]


> Две то по любому встанут, а вот больше...

И больше тоже встанут.
В моей практике имелась одновременная работа с 4-мя картами на борту - SB Audigy2, SBLive, Realtek и CrystalSound. Ресурсы системы при этом были выделены вполне корректно.


> Acidlex   (27.04.06 13:54) [6]
>
> использование нескольких источников записи одновременно
> (CD, Line in, Aux ....)?


Микшер AC"97-кодека такое не позволяет. Либо запись с одного источника, либо с другого, но не с нескольких одновременно.



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

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

Наверх




Память: 0.5 MB
Время: 0.08 c
15-1153491701
stud
2006-07-21 18:21
2006.08.20
осаго при дтп. вот вопрос.


1-1152113846
Muchacho
2006-07-05 19:37
2006.08.20
генератор отчетов для Delphi 2006 .NET


5-1137932033
hawkins
2006-01-22 15:13
2006.08.20
ZipTV триальная версия


2-1154009086
Ega23
2006-07-27 18:04
2006.08.20
Визуализация длительной загрузки


15-1153345052
Alert2006
2006-07-20 01:37
2006.08.20
Нужен чат