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

Вниз

Записать сигнал с линейного входа   Найти похожие ветки 

← →
Gray   (2003-12-11 09:21) [0]

Необходимо производить снятие информации с АЦП Sound-карты в реальном масштабе времени. Пробовал через TMediaPlayar, но там сначала необходимо записать в файл, а затем только можно приступать к обработке полученной информации.

---

← →
Sergo ©   (2003-12-11 09:39) [1]

Можно вот так (это для снятия сигнала с микрофона), потом эти данные нужно обработать фильтрами и FFT, но под виндой ты не получишь реального масштаба времени. Хотя...все зависит от поставленной задачи.

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);
 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;
   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;

---

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

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

Наверх

Память: 0.48 MB
Время: 0.036 c