unit SoundTemp;

interface
uses
  Windows, Messages, SysUtils, Classes,  mmsystem,math;
/// объявленные процедуры и функции
 procedure CreateSound(Channels:byte;fq:integer;bytsec:integer;
                block:byte;bits:byte;bytesrecord:integer);//инициализация звуквой карты
 procedure msgWavIn;
 procedure StartInSound(formHwnd:integer);
function grafsignal(vid:integer;mash:integer;kontec:integer;X0:integer;Xn:integer;Ykf:integer;Ycm:integer;colP:integer;colL:integer):integer;
 procedure clearHDC(kontec:integer);
 procedure StopInSaund;
var
   temper:real;

implementation
 uses OSCHILOGRAF;
type
   Tmemblock = array[0..100000] of byte; //буфер данных
   PmemBlock=^TmemBlock;
   PHeader=^TwaveHdr; //указатель на TwaveHdr

 var WaveFormat: PPCMwaveFormat;
        i:MMResult;
       DMemBlock:TmemBlock;
        HwaveIn:PHwaveIn;
        Header:TwaveHdr;
        memBlock : PmemBlock;
     ss1, ss,ssl,s2,hwd,s4: integer;
     s1,s3:byte;

///////////////////////////////////////////////////////////////
function faza():integer; //устраняет сдвиг фаз
var i,ni:integer;
begin
result:=0;
  for i:=400 to 4000 do
    begin
     s1:= DMemBlock[i*4+2];//младший байт
     if s1>$80 then s1:=-($ff-s1) else s1:=0;//отрицательное значение
     s2:= DMemBlock[(i*4+3)];//старший байт
     if s2 >$80 then  ss:=-(($ff-s2)*$ff)+s1 else  ss:=0;
 //если полуволна положительна
    if ss=0 then
     begin
     for ni:=i to 800 do
      begin
       s1:= DMemBlock[ni*4+2];//младший байт
        if s1>$80 then s1:=-($ff-s1) else s1:=0;
         s2:= DMemBlock[(ni*4+3)];
          if s2 >$80 then  ss:=-(($ff-s2)*$ff)+s1 else ss:=0;//
           if ss<-100 then begin //порог синхронизации
              result:=ni;
             exit;
              end;
           end;
        end;
  end;
 end;

/////////////////////////////////////////////////////////////////////////////////////
///инициилизируем зкуковую карту
procedure CreateSound(Channels:byte;fq:integer;bytsec:integer;block:byte;bits:byte;bytesrecord:integer);
begin
 if WaveInGetNumDevs = 0 then messagebox(0,'Error', 'нет звуковой платы', 0);
WaveFormat := new(PPCMwaveFormat);
with WaveFormat^.wf do
  begin
   WFormatTag := WAVE_FORMAT_PCM; {PCM format}
   NChannels:=Channels; {mono1 stereo2}
   NSamplesPerSec:=fq; {11kHz sampling}
   NAvgBytesPerSec:=bytsec; {we aim to use 8 bit sound so only 11k per second}
    NBlockAlign:=block; {only one byte in each sample}
  waveformat^.wBitsPerSample:=bits; {8 bits in each sample}
  end;
     memBlock:=new(PmemBlock);
        with header do  begin
    lpdata:= @DMemBlock;//pointer(memBlock);
      dwbytesrecorded:=bytesrecord;
      dwbufferlength:=bytesrecord;
    dwUser:=0;
    dwflags:=0;
    dwloops:=0;
       end;
end;

//////////////////////////////////////////////////////////////////////////
procedure msgWavIn;
begin
  waveInPrepareHeader(HWaveIn^,@Header,sizeof(TWavehdr)); //подготовить буфер звук.карты
  waveInAddBuffer(HWaveIn^, @Header,   sizeof(TWavehdr));//передать данные
  waveInUnprepareHeader(HWaveIn^,@Header,sizeof(TWavehdr)); //освободить буфер

end;
////считать данные из звуковой карты//////////////////////////////////////////////////////////////////////
procedure StartInSound(formHwnd:integer);
begin
//выделить память
  HwaveIn:=new(PHwaveIn);
//открыть зв.карту, определяем Callback функцию формы Form2
i:=waveInOpen(HWaveIn,WAVE_MAPPER,@waveformat^.wf,formHwnd,0,CALLBACK_WINDOW);
   if i<>0 then  messagebox(0,'Error', 'не открывается waveIn', 0);
//готовим буфер звук.карты
i:=waveInPrepareHeader(HWaveIn^,@Header,sizeof(TWavehdr));
   if i<>0 then  messagebox(0,'Out Prepare error','error',0);
// передаем данные в буфер
i:=waveInAddBuffer(HWaveIn^, @Header,   sizeof(TWavehdr));
// освобождаем буфер звук.карты
i:=waveInUnprepareHeader(HWaveIn^,@Header,sizeof(TWavehdr));
// включаем запись
i:=waveInStart(HWaveIn^);
   if i<>0 then   messagebox(0,'Wave out error','error',0);
end;
/////отображаем осцилограф. данные/////////////////////////////////////////////////////////////////////
function grafsignal(vid:integer;mash:integer;kontec:integer;X0:integer;Xn:integer;Ykf:integer;Ycm:integer;colP:integer;colL:integer):integer;
var pen1,pen2,X,n:integer;
begin
DeleteObject(pen1);
DeleteObject(pen2); //освободить перья
pen2:=CreatePen(PS_SOLID,1,colP);//создать перо
pen1:=CreatePen(PS_SOLID,1,colL);
if mash=0 then mash:=1; //маштаб

releaseDC(kontec,hwd); // освободить контекст
hwd:= getdc(kontec);  // создать контекст
//releaseDC(kontec,hwd); //
if OSCHILOGRAF.Form2.CheckBox1.Checked then  n:=faza else n:=0;
i:=0;
 for i:=n+X0 to Xn+n do begin       //
               s1:= DMemBlock[i*4+2];//младший байт
               if s1>$80 then s1:=($ff-s1);
               s2:= DMemBlock[(i*4+3)];
             if s2 >127 then  ss:=-(($ff-s2)*255)+s1 else ss:=s1+(s2*255);

 if mash<0 then X:=(i-n-X0)*(-mash) else X:= (i-n-X0)div mash;
     if vid=0 then begin
                  setpixelV(hwd,X,((ss div Ykf)+Ycm),colP); //нарисовать точку
                    end;
      if vid=1 then begin
                SelectObject(hwd,pen1);//подключить перо
                lineto(hwd,X,((ss div Ykf)+Ycm)); //нарисовать линию
                    end;
        end;
  ////////////////////////////////////////////////////////////////////////////////////
  movetoex(hwd,0,0,nil);
  i:=0;
  for i:=n+X0 to Xn+n do begin
                s3:= DMemBlock[i*4+0];//младший байт
                if s3>$80 then s3:=($ff-s3);
               s4:= DMemBlock[(i*4+1)];
             if s4 >127 then  ss1:=-(($ff-s4)*255)+s3 else ss1:=s3+(s4*255);
  if mash<0 then X:=(i-n-X0)*(-mash) else X:= (i-n-X0)div mash;
     if vid=0 then begin
                    setpixelV(hwd,X,((ss1 div Ykf)+Ycm),colL);//
                    end;
      if vid=1 then begin
                SelectObject(hwd,pen2);  lineto(hwd,X,((ss1 div Ykf)+Ycm));
                    end;

        end;
         ss:=0; ssl:=0;
           result:=0;
DeleteObject(pen1);DeleteObject(pen2); //освободить перья
 end;
 //очистить контест
procedure clearHDC(kontec:integer);
begin
InvalidateRect(kontec, NiL, true);

end;
procedure StopInSaund;
begin
Dispose(HwaveIn);
end;
end.