DirectSound

← →
sanelo © (2006-06-15 09:18) [0]

Всем доброго времени суток.
Люди помогите пожайлуста, как при помощи Dsound записать звук с микрофона
Я пробовал так

if DirectSoundCaptureCreate(nil,DCapture,nil) <> DS_OK then
raise Exception.Create("Create Capture failed");
with CaptureDesc do
begin
dwSize:=SizeOf(DSCBUFFERDESC);
dwFlags:=3;
dwBufferBytes:=10000;
lpwfxFormat:=nil;
end;
with Caps do
begin
dwSize:=SizeOf(DSCBUFFERDESC);
end;
DCapture.GetCaps(Caps);

if DCapture.CreateCaptureBuffer(CaptureDesc,DCaptureBuffer,nil) <> DS_OK then
raise Exception.Create("Create Capture Buffer failed");
объект утр-ва захвата вродь создаеться а вот буфер не хочет
Caps возвращает все нули

заранее спасибо!!!

← →
Константинов © (2006-06-19 00:58) [1]

поковырятесь здесь. (FAQ от АП)
unit receiver; interface uses mmsystem, classes; const samp_per_sec = 44100; samp_cnt = samp_per_sec div 5; buf_len = samp_cnt * 2; type PSample16M = ^TSample16M; TSample16M = SmallInt; PArrayOfSample = ^TArrayOfSample; TArrayOfSample = array[1..samp_cnt] of TSample16M; TReceiver = class private hwi: Integer; fmt: tWAVEFORMATEX; whdr1: WAVEHDR; buf1: TArrayOfSample; whdr2: WAVEHDR; buf2: TArrayOfSample; FStoped: Boolean; FOnChange: TNotifyEvent; procedure SetStoped(const Value: Boolean); public Peak: Integer; Buffer: PArrayOfSample; destructor Destroy; override; procedure Start; procedure Stop; property Stoped: Boolean read FStoped write SetStoped; property OnChange: TNotifyEvent read FOnChange write FOnChange; end; var rec: TReceiver; implementation procedure waveInProc(const hwi, uMsg, dwInstance: Integer; var hdr: WAVEHDR; const dwP2: Integer); stdcall; const divs = samp_cnt div 100; var i, p: Integer; buf: PArrayOfSample; begin if rec.Stoped then Exit; case uMsg of WIM_OPEN: begin end; WIM_DATA: begin rec.Buffer := PArrayOfSample(hdr.lpData); buf := PArrayOfSample(hdr.lpData); p := 0; for i := 0 to samp_cnt div divs do p := p + Abs(buf[i * divs]); rec.Peak := p div (samp_cnt div divs); if Assigned(rec.FOnChange) then rec.FOnChange(rec); waveInUnprepareHeader(hwi, @hdr, SizeOf(WAVEHDR)); waveInPrepareHeader(hwi, @hdr, SizeOf(WAVEHDR)); waveInAddBuffer(hwi, @hdr, SizeOf(WAVEHDR)); end; WIM_CLOSE: begin end; end; end; { TReceiver } destructor TReceiver.Destroy; begin Stoped := True; inherited; end; procedure TReceiver.SetStoped(const Value: Boolean); begin FStoped := Value; if Value then begin waveInStop(hwi); waveInUnprepareHeader(hwi, @whdr1, SizeOf(WAVEHDR)); waveInUnprepareHeader(hwi, @whdr2, SizeOf(WAVEHDR)); waveInReset(hwi); waveInClose(hwi); end else begin with fmt do begin wFormatTag := WAVE_FORMAT_PCM; nChannels := 1; nSamplesPerSec := samp_per_sec; nBlockAlign := 2; nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; wBitsPerSample := 16; cbSize := 0; end; waveInOpen(@hwi, WAVE_MAPPER, @fmt, Cardinal(@waveInProc), hInstance, CALLBACK_FUNCTION); with whdr1 do begin lpData := @buf1; dwBufferLength := buf_len; dwBytesRecorded := 0; dwUser := 0; dwFlags := 0; dwLoops := 0; lpNext := nil; reserved := 0; end; waveInPrepareHeader(hwi, @whdr1, SizeOf(WAVEHDR)); waveInAddBuffer(hwi, @whdr1, SizeOf(WAVEHDR)); with whdr2 do begin lpData := @buf2; dwBufferLength := buf_len; dwBytesRecorded := 0; dwUser := 0; dwFlags := 0; dwLoops := 0; lpNext := nil; reserved := 0; end; waveInPrepareHeader(hwi, @whdr2, SizeOf(WAVEHDR)); waveInAddBuffer(hwi, @whdr2, SizeOf(WAVEHDR)); waveInStart(hwi); end; end; procedure TReceiver.Start; begin Stoped := False; end; procedure TReceiver.Stop; begin Stoped := True; end; initialization rec := TReceiver.Create; finalization rec.Free; end.

← →
medved_68 © (2006-06-19 14:35) [2]

Константинов
А воспроизведения того, что пишет при помощи блоков случаем нет???
Очень надо, а то писать пишу а при воспроизведении вернее при открытии карты через WiveOutOpen лезет какаято ошибка короче handle устроиства равен 0. Заранее спасибо

← →
sanelo © (2006-06-27 11:46) [3]

Вот короче делал я через API вроде работает, только я заметил что не на всех звуковых карточках посмотри поковыряй

procedure TGlav.But_startClick(Sender: TObject);
begin

{Îïðåäåëÿåì ïîðò è çàïóñêàåì ñåðâåð}
ServerSocket1.Port := 3000;
{Ìåòîä Insert âñòàâëÿåò ñòðîêó â ìàññèâ â óêàçàííóþ ïîçèöèþ}
ServerSocket1.Open;

Edit1.Text:="listen";
But_start.Enabled:=false;
But_stop.Enabled:=true;
//But_send.Enabled:=true;
end;

procedure TGlav.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
label m1;
var i:integer;
begin
Edit1.Text:="clien conn";
conn_fl:=true;
But_send.Enabled:=true;
for i:=1 to kol_ab do
if abon.ip[i]=ServerSocket1.Socket.Connections[0].RemoteAddress then
begin
Edit2.Text:=abon.nick[i];
exit;
end;
end;

procedure TGlav.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Edit1.Text:="listen";
But_send.Enabled:=false;
conn_fl:=false;
cl_fl:=false;
Memo1.Clear;
end;

procedure TGlav.But_connClick(Sender: TObject);
label m1;
var i:byte;
begin
cl_fl:=true;
for i:=1 to 100 do
begin
str:=abon.nick[i];
if ComboBox1.Text=str then goto m1;
end;
m1:

ClientSocket1.Port:=3000;
ClientSocket1.Address:=abon.ip[i];
ClientSocket1.Open;
Edit4.Text:="connect";
But_send.Enabled:=true;
end;

procedure TGlav.But_sendClick(Sender: TObject);
var i:byte;
begin
if cl_fl=false then
begin
ServerSocket1.Socket.Connections[0].SendText(Edit3.Text);
Memo1.Lines.Add(Edit3.Text);
end;
if cl_fl=true then
begin
ClientSocket1.Socket.SendText(Edit3.Text);
Memo1.Lines.Add(Edit3.Text);
end;
Edit3.Text:="";
//sendfile;
end;

procedure TGlav.But_send_klClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText("ffff");
end;

procedure TGlav.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
l: Integer;
m1: TMemoryStream;
buf1:pchar;
begin

Socket.ReceiveBuf(buf,bufhead.dwBufferLength);

end;

procedure TGlav.FormShow(Sender: TObject);
var i:byte;n:boolean;
begin

ch:=1;
BufSize := 800; { Ðàçìåð áóôåðà }
Bits16 := CheckBox1.Checked;
with header do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1; { êîëè÷åñòâî êàíàëîâ }
nSamplesPerSec := 20050; { ÷àñòîòà }
wBitsPerSample := 8; { 8 / 16 áèò }
nBlockAlign := nChannels * (wBitsPerSample div 8);
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
Memo1.Clear;
Edit1.Text:="";Edit2.Text:="";Edit3.Text:="";Edit4.Text:="";
n:=false;
path:=ExtractFilePath(Application.ExeName);
path:=path+"abonents";
assignfile(fw, path );
{$I-}
reset(fw);
{$I+}
if ioresult<>0 then begin Rewrite(fw);n:=true; end;
seek(fw,0);
if n=false then Read(fw,abon);

ComboBox1.Clear;
i:=1;
while abon.ip[i]<>"" do
begin
ComboBox1.Items.Add(abon.nick[i]);
i:=i+1;
end;
kol_ab:=i-1;
But_send.Enabled:=false;
WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),
Glav.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));
WaveoutOpen(Addr(Waveout), WAVE_MAPPER, addr(header),
Glav.Handle, 0,CALLBACK_WINDOW);
waveOutSetVolume(waveout,999999999);
end;

procedure TGlav.But_disconnClick(Sender: TObject);
begin
ClientSocket1.Socket.Close;
Edit4.Text:="disconnect";
Memo1.Clear;
cl_fl:=false;
end;

procedure TGlav.But_stopClick(Sender: TObject);
begin
ServerSocket1.Socket.Close;
Edit1.Text:="";
But_start.Enabled:=true;
But_stop.Enabled:=false;
end;

procedure TGlav.But_addClick(Sender: TObject);
begin
new_nick.showmodal;
end;

procedure TGlav.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(Socket.Receivetext);
end;

procedure TGlav.Button1Click(Sender: TObject);
begin
WaveInStart(WaveIn);
end;

procedure Tglav.OnWaveIn;
var
f:TFileStream;
i: integer;
data8: PData8;
data16: PData16;
h: integer;
XScale, YScale: single;
buf1:PChar;
begin

if conn_fl=true then
begin
ServerSocket1.Socket.Connections[0].SendBuf(buf,BufHead.dwBufferLength);
end
else
begin
waveOutWrite(waveout,addr(bufhead),sizeof(BufHead));
waveOutReset(waveout);
end;
WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
WaveInStart(WaveIn);

end;

procedure TGlav.But_editClick(Sender: TObject);
begin
ed_fl:=true;del_fl:=false;
edit_nick.showmodal;
end;

procedure TGlav.But_delClick(Sender: TObject);
begin
del_fl:=true;ed_fl:=false;
edit_nick.showmodal;
end;

procedure TGlav.FormCreate(Sender: TObject);
begin
TrackBar1.OnChange := CheckBox1Click;
Button1.Caption := "Start";
Button2.Caption := "Stop";
CheckBox1.Caption := "16 / 8 bit";
end;

procedure TGlav.CheckBox1Click(Sender: TObject);
begin
if stop then
begin
Button2.Click;
Button1.Click;
end;

end;

procedure TGlav.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 TGlav.NMGeneralServer1ClientContact(Sender: TObject);
var i:integer;
begin
Edit1.Text:="clien conn";
conn_fl:=true;
But_send.Enabled:=true;
for i:=1 to kol_ab do
if abon.ip[i]=ClientSocket1.Address then
begin
Edit2.Text:=abon.nick[i];
exit;
end;

end;

procedure TGlav.IdTCPServer1Connect(AThread: TIdPeerThread);
var i:integer;
begin
Edit1.Text:="clien conn";
conn_fl:=true;
But_send.Enabled:=true;
//for i:=1 to kol_ab do
// if abon.ip[i]=IdTCPServer1.Bindings.Items[0].IP then
// begin
// Edit2.Text:=abon.nick[i];
// exit;
// end;

end;

end.

тут основные пр-ры FormShow и Button1.click

DirectSound Найти похожие ветки