DelphiX i nagrywanie dziekóf :D

To znofu ja :D

miałem kiedys kod źrudłowy HDD RECORDER był to taki programik do nagrywania dzwieków :D ale niestety miałem dawno temu przypodkowe formatowanie i mi sie usunoł :P i kodów już nie moge znaleŹć w necie :(
programik był oparty na komponecie DXWAVE czy innego komponętu DelphiX :D

no i wie ktoś jak taki progrgam wykonac do nagywania dzieków i wybierania sobie jakosci dziwku??

masz tu unit do nagrywania dzwieku......

unit wave_rec;

interface
uses mmsystem;

procedure StartRec;
procedure Stoprec;

const
bufcount = 120;

var
prepared : boolean;
buffer : array[0..bufcount -1] of array of byte;
actualbuf : integer;
buflen : cardinal;
mmRes : mmresult;

implementation

var
hWin : HWAVEIN;
WaveFormat : TWaveformatex;
WaveHeader : array[0..bufcount-1] of wavehdr;

procedure CreateBuf;
var
i : integer;

begin
WaveFormat.wFormatTag := Wave_format_PCM; //format PCM
WaveFormat.nSamplesPerSec := 16000; //16 khz/ 8000 8khz
waveformat.nChannels := 2; //stereo /1 - mono
waveformat.wBitsPerSample := 16; //16 bitów
waveformat.nBlockAlign := waveformat.nChannels * (waveformat.wBitsPerSample div 16);
Waveformat.nAvgBytesPerSec := WaveFormat.nSamplesPerSec * waveformat.nBlockAlign;
waveformat.cbSize := 0;
buflen := waveformat.nAvgBytesPerSec div 2;
for i:=0 to bufcount - 1 do
begin
SetLength(buffer[i], buflen);
end;

end;

function CollbackProc(hwin : hwavein; umsg, dwins, dw1, dw2 : LongWord) : mmresult; stdcall;
var
i : integer;
begin
if umsg = wim_data then
begin

for i:=0 to bufcount-1 do
begin
if LongWord(@WaveHeader[i]) = dw1 then
begin
actualbuf := 1;
break;
end;
end;

mmres := waveinunprepareheader(hwin,@waveheader[actualbuf],sizeof(waveheader[actualbuf]));
end;
result := 0;

end;

procedure StartRec;
var
i : integer;
begin
if prepared then exit;

mmres := waveinopen(@hwin,wave_mapper,@waveformat,cardinal(@collbackproc), 0,callback_function);

if mmres mmsyserr_noerror then exit;

for i:=0 to bufcount - 1 do
begin
WaveHeader[i].lpData := @buffer[i,0];
waveheader[i].dwBufferLength := buflen;

mmres := WaveInprepareheader(hwin,@waveheader[i],sizeof(waveheader[i]));
if mmres mmsyserr_noerror then exit;

mmres := waveinaddbuffer(hwin,@waveheader[i], sizeof(waveheader[i]));
if mmres mmsyserr_noerror then exit;

end;
mmres := waveinstart(hwin);
if mmres mmsyserr_noerror then exit;
actualbuf := -1;
prepared := true;

end;

Procedure StopRec;
var
i : integer;
begin
if prepared then
begin
mmres := waveinreset(hwin);
for i:=0 to bufcount do
begin
mmres := waveinunprepareheader(hwin,@waveheader[i],sizeof(waveheader[i]));
end;
mmres := waveinclose(hwin);
prepared := false;
end;

end;

initialization
actualbuf := -1;
prepared := false;
createbuf;

end.