Запись звука с микрофона

← →
AlexanderSK (2003-09-23 15:01) [0]

Требуется записать звук с микрофона. Использую API-шные функции. Под
Win 98 все работает без особых нареканий, но под Win XP возникают
крупные проблеммы.

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;
end;
//выделяю блок памяти, куда будут записаны данные

WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
//добовляю буфер, в котором есть ссылка на выделенный блок памяти, в
очередь для записи

WaveInStart(WaveIn);
//запускаю запись

После этого жду сообщения MM_WIM_DATA и получив это сообщение я
вынимаю из буфера данные, которые записаны. Под Win 98 все работает. Но вот под Win XP начинается веселье. Это самое
сообщение окно получает на порядок чаще чем должно. В результате 2-х
секундная запись растягивается секунд в 20 (понятно, что запись
абсолютно безумная). Пытался писать только то количество бит, которое
реально записано - еще хуже.

Что можно попробовать поправить или как можно выловаить проблемму?

← →
AlexanderSK (2003-09-25 10:09) [1]

Ну не ужто ни у кого никаких мыслей на это туму?

← →
Verg (2003-09-26 14:38) [2]

Где делаешь waveinUnprepareHeader?

По-моему последоватеьность такова:

1. Готовим буфер (prepareheader)
2. Закладываем его (addbuffer);
3. Ждем его готовности (или сообщения, event-а и т.п.)
4. Полученные данные из буфера куда-то скидываем (в поток напр.)
5. unprepareheader
6. goto п.1

А вообще-то лучше работать с парочкой буферов. Иначе пока ты тратишь время на скидывание результата куда-нибудь время то идет, звук на входе не может же подождать, пока прога управится с очередным буфером.

← →
AlexanderSK (2003-09-29 18:07) [3]

Пробовал. Не помогло!

Два буфера позже, с одним бы разобраться!
Хотя на счет двух буферов и правда, но пока на дыры в записи наплевать!

← →
Sergo (2003-10-01 15:37) [4]

Вот код от моей проги. Задачи у нас в принципе похоже. Под ХР работает. Отредактишь его под себя.
unit mainform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,mmsystem, StdCtrls, Spin, Buttons,Registry, VrControls, VrScale, VrLcd,VrMeter, VrBorder, VrHyperCtrls, VrButtons, Menus, XPMenu; type TForm1 = class(TForm) Timer1: TTimer; Image1: TImage; Image2: TImage; Bevel1: TBevel; Bevel2: TBevel; VrScale1: TVrScale; VrScale2: TVrScale; VrMeter1: TVrMeter; VrScale4: TVrScale; Panel1: TPanel; Panel2: TPanel; Label5: TLabel; Label6: TLabel; VrShadowButton1: TVrShadowButton; VrShadowButton2: TVrShadowButton; VrShadowButton3: TVrShadowButton; VrShadowButton4: TVrShadowButton; Panel3: TPanel; Label3: TLabel; Label7: TLabel; VrNum3: TVrNum; VrNum4: TVrNum; Label1: TLabel; VrScale3: TVrScale; MainMenu1: TMainMenu; File1: TMenuItem; Help1: TMenuItem; Setting1: TMenuItem; Exit1: TMenuItem; Exit2: TMenuItem; Help2: TMenuItem; About1: TMenuItem; XPMenu1: TXPMenu; Exit3: TMenuItem; About2: TMenuItem; OpenDialog1: TOpenDialog; Exit4: TMenuItem; PrintDialog1: TPrintDialog; PrinterSetupDialog1: TPrinterSetupDialog; FontDialog1: TFontDialog; Timer2: TTimer; Timer3: TTimer; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure VrShadowButton1Click(Sender: TObject); procedure VrShadowButton2Click(Sender: TObject); procedure Exit4Click(Sender: TObject); private procedure WaveInEndBlock(var msg:integer); message MM_WIM_DATA; public { Public declarations } end; var Form1: TForm1; //GLOBAL VARIABLES addres_func,a:integer; glob_count:int64; count:integer; handl:hwaveout; w:tpcmwaveformat; e:TWaveHdr; buffer1:array [0..4000] of byte; buffer2:array [0..4000] of byte; buffer3:array [0..4000] of byte; compbuf:array[1..20000] of byte; //for compressed sound tek_blok_in, tek_blok_out,intekposfile:integer; fftcol, del // :integer; //FFT колво отсчетов showsign,showspec:boolean; // compress:boolean;// realtime compress tim:MMTIME; implementation uses dsp; var header:array[1..44]of byte; //--------------SAVE SOUND------------------------------------------------------ procedure TForm1.WaveInEndBlock(var msg:integer); begin if tek_blok_in=1 then begin tek_blok_in:=2; e.dwFlags:=WHDR_DONE; e.lpData:=@buffer3; waveinPrepareHeader(handl,@e,sizeof(e)); waveinaddbuffer(handl,@e,sizeof(e)); exit; end; if tek_blok_in=2 then begin tek_blok_in:=3; e.dwFlags:=WHDR_DONE; e.lpData:=@buffer1; waveinPrepareHeader(handl,@e,sizeof(e)); waveinaddbuffer(handl,@e,sizeof(e)); exit; end; if tek_blok_in=3 then begin tek_blok_in:=1; e.dwFlags:=WHDR_DONE; e.lpData:=@buffer2; waveinPrepareHeader(handl,@e,sizeof(e)); waveinaddbuffer(handl,@e,sizeof(e)); exit; end ; end; {$R *.DFM} {$R TABLO.RES} procedure TForm1.FormCreate(Sender: TObject); var i:integer; bmp:TBitmap; begin SetPriorityClass( GetCurrentProcess(), HIGH_PRIORITY_CLASS); SetThreadPriority(GetCurrentProcess(), THREAD_PRIORITY_TIME_CRITICAL); compress:=true; showspec:=true; showsign:=true; bmp:=TBitmap.Create; bmp.LoadFromResourceName(HINSTANCE,"FON"); image1.Canvas.Draw(0,0,bmp); image2.Canvas.Draw(0,0,bmp); bmp.Free; del:=20; fftcol:=200; glob_count:=0; tek_blok_in:=1; for i:=1 to 4000 do begin buffer1[i]:=0; buffer2[i]:=0; buffer3[i]:=0; end; for i:=1 to 20000 do compbuf[i]:=0; // tim.wType:=TIME_SAMPLES; addres_func:=form1.Handle; w.wf.nChannels:=1; // mono w.wf.nSamplesPerSec:=8000; // 8 kHz w.wBitsPerSample:=8; // 1 byte per sample w.wf.wFormatTag:=1 ; // тип формата PCM=1 (ИКМ 64кбит/с) w.wf.nBlockAlign:=(w.wf.nChannels*w.wBitsPerSample) div 8; // выравнивание = (Channels*BitsPerSample) DIV 8 w.wf.nAvgBytesPerSec:=w.wf.nSamplesPerSec*w.wf.nBlockAlign; // BYTE в секунду = SamplesPerSec*BlockAlign e.lpData:=@buffer1; e.dwBufferLength:=sizeof(buffer1); e.dwBytesRecorded:=0; e.dwUser:=0; e.dwFlags:=WHDR_done; e.dwLoops:=1; e.reserved:=0; end; procedure TForm1.Timer1Timer(Sender: TObject); var bmp1,bmp2:TBitmap; i:integer; sign,spec,spi:array[0..200] of single; b:byte; c:extended; v:integer; v1:integer; begin timer1.Enabled:=false; try bmp1:=TBitmap.Create; bmp2:=TBitmap.Create; bmp1.LoadFromResourceName(HINSTANCE,"FON"); bmp2.LoadFromResourceName(HINSTANCE,"FON"); bmp1.Canvas.Pen.Color:=cllime; bmp2.Canvas.Pen.Color:=cllime; with bmp1.Canvas do begin if tek_blok_in=1 then begin moveto(1,buffer1[count]-66); for i:=count+1 to count+200 do begin lineto(i-count,buffer1[i]-66); sign[i-count-1]:=buffer1[i]; c:=buffer1[i]-128; end; end; if tek_blok_in=2 then begin moveto(1,buffer2[count]-66); for i:=count+1 to count+200 do begin lineto(i-count,buffer2[i]-66); sign[i-count-1]:=buffer2[i]; c:=buffer2[i]-128; end; end; if tek_blok_in=3 then begin moveto(1,buffer3[count]-66); for i:=count+1 to count+200 do begin lineto(i-count,buffer3[i]-66); sign[i-count-1]:=buffer3[i]; c:=buffer3[i]-128; end; end; end; if showsign then Image1.Canvas.Draw(0,0,bmp1); if showspec then begin ClassicDirect(sign,spec,spi,fftcol); with bmp2.Canvas do begin b:=trunc(400/fftcol); v1:=0; for i:=1 to trunc(fftcol/2)-1 do begin moveto(i*b+4,98); lineto(i*b+4,97-abs(trunc(spec[i]/del))); end; end; Image2.canvas.Draw(0,0,bmp2); count:=(count+200)mod 4000; end; finally bmp1.Free; bmp2.Free; end; timer1.Enabled:=true; end; procedure TForm1.VrShadowButton1Click(Sender: TObject); begin if waveinopen(@handl,wave_mapper,@w,addres_func,0, CALLBACK_window )<>0 then begin showmessage("Ошибка открытия"); exit; end; if waveinPrepareHeader(handl,@e,sizeof(e))<>0 then begin showmessage("Ошибка подготовки");end ; waveinstart(handl); waveInAddBuffer(handl,@e,sizeof(e)); tek_blok_in:=1; timer1.Enabled:=true; end; procedure TForm1.VrShadowButton2Click(Sender: TObject); begin timer1.Enabled:=false; a:= waveinreset(handl); if waveinclose(handl)<>0 then begin showmessage("ОШИБКА ЗАКРЫТИЯ"); exit; end; end; procedure TForm1.Exit4Click(Sender: TObject); begin close; end; end.

Запись звука с микрофона Найти похожие ветки