Форум: "Потрепаться";
Текущий архив: 2003.11.27;
Скачать: [xml.tar.bz2];

Вниз

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

← →
Incomer   (2003-11-04 13:20) [0]

FOR ALL ...
Несколько примеров по работе с микрофоном plz
Приветствуются и линки на компоненти
10Х

---

← →
Fredericco   (2003-11-04 13:31) [1]


....
uses ...MMSystem...
....

type
TArrayBuf = array[0..1023]of byte;//1 KByte
PArrayBuf = ^TArrayBuf;
TForm1=class(TForm)
......
public
WaveFormat:TWaveFormatEx;
WaveIn:PHWaveIn;
IsOn:boolean;
Procedure WNDPROC(var msg:TMessage);override;
Procedure InitWaveIn(mBool:boolean);
{ Public declarations }
end;

var
Bufi1:Array[0..1023] of double;

.......
Procedure Tform1.WNDPROC(var msg:TMessage);
var
Hdr:PWaveHdr;
begin
INHERITED;
case msg.Msg of
MM_WIM_OPEN:
begin

end;
MM_WIM_CLOSE:
begin
end;
MM_WIM_DATA:
begin
Hdr:=PWaveHdr(msg.LParam);

for i:=0 to hdr^.dwBytesRecorded-1 do begin
Bufi1[i]:=PArrayBuf(hdr.lpData)^[i];//Оцифрованный звук
end;

WaveInUnprepareHeader(WaveIn^,hdr,Sizeof(TWaveHdr));

Dispose(hdr.lpData);
DisPose(hdr);

if isOn=false then
exit;

Hdr:=new(PWaveHdr);
Hdr^.lpData:=pointer(new(PArrayBuf));
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; //Case
end;

Procedure Tform1.InitWaveIn(mBool:boolean);
var
i:integer;
WaveHdr:PWaveHdr;
DaBuffer:PArrayBuf;
openError,PrepareError,BufferAddError,StartError:integer;
begin
if mBool then
begin
WaveFormat.wFormatTag:=WAVE_FORMAT_PCM;
WaveFormat.nChannels:=2; //Моно
WaveFormat.nSamplesPerSec:=11025;
WaveFormat.nAvgBytesPerSec:=11025;
WaveFormat.nBlockAlign:=4;
WaveFormat.wBitsPerSample:=8;

WaveIn:=new(PHWaveIn);
openError:=WaveInOpen(WaveIn,0,@WaveFormat,handle,0,CALLBACK_WINDOW);
for i:=1 to 8 do
begin
DaBuffer:=new(PArrayBuf);
WaveHdr:=new(PWaveHdr);
with WaveHdr^ do
begin
lpData:=pointer(DaBuffer);
dwBufferLength:=sizeof(DaBuffer);//1024 = 1 Kb
dwBytesRecorded:=0;
dwUser:=0;
dwFlags:=0;
dwLoops:=0;
end;
PrepareError:=WaveInPrepareHeader(WaveIn^,WaveHdr,sizeOf(TWaveHdr));
BufferAddError:=WaveInAddBuffer(WaveIn^,WaveHdr,Sizeof(TWaveHdr));
end;
StartError:=WaveInStart(WaveIn^);

if (openError<>0)or(PrepareError<>0)or(BufferAddError<>0)or(StartError<>0)then
Showmessage("Error, mlin");
end else
begin
WaveInStop(WaveIn^);
if WaveIn<>nil then WaveInReset(WaveIn^);
if WaveIn<>nil then WaveInClose(WaveIn^);
Dispose(WaveIn);
end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
IsOn:=true;
InitWaveIn(true);
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
IsOn:=false;
InitWaveIn(false);
end;



---

← →
Fredericco   (2003-11-04 13:33) [2]

Не забывай говорить пожалуйста.

---

← →
Ru   (2003-11-04 13:34) [3]

Да пре будет с тобой http://www.un4seen.com/ ну и прочая такая фигня http://www.fmod.org

---

← →
Incomer   (2003-11-04 13:44) [4]

10X

---

← →
Fredericco   (2003-11-04 13:45) [5]

Удалено модератором

---

← →
isko   (2003-11-04 13:46) [6]

Fredericco © -
вы же 10X не осветили:)

---

← →
Fredericco   (2003-11-04 13:48) [7]

2 Fredericco © (04.11.03 13:45) [5]
Мы с Ру требуем предоплату!!! :-))))

---

← →
Incomer   (2003-11-04 13:50) [8]

2 Fredericco & Ru - 10X - excluzive - (:-

---

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

Форум: "Потрепаться";
Текущий архив: 2003.11.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.007 c