Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2006.08.20;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2006.08.20;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.085 c
2-1154440550
lorn
2006-08-01 17:55
2006.08.20
treview значение узла


11-1131571657
Flea
2005-11-10 00:27
2006.08.20
вопрос по PopupMenu


2-1154026953
ronyn
2006-07-27 23:02
2006.08.20
Дата создания файла - сравнить


2-1154507733
Id
2006-08-02 12:35
2006.08.20
Word and Delphi


6-1144128262
CyMKuH
2006-04-04 09:24
2006.08.20
FTP клиент





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский