Форум: "Media";
Текущий архив: 2007.02.25;
Скачать: [xml.tar.bz2];
Вниз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.
← →
sanelo © (2006-06-27 11:50) [4]тут основные пр-ры FormShow и Button1.click
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2007.02.25;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.054 c